公共測量、土木設計、用地境界測量、土木建築用測量、土地調査、各種申請etc...株式会社 滝下測量設計事務所(京都府綾部市、福知山市)

お問い合わせ

(VBA)座標SIMAデータを扱うクラスモジュール

座標SIMAデータをVBA上で扱うクラスモジュールです。下に記載している標準モジュール側で呼び出して使用します。

'クラスモジュール
'オブジェクト名を"Zahyo"とする
Option Explicit

'制限
Private Const MAX_NO = 999999
Private Const MIN_NO = 0
Private Const MAX_NAME = 16

'変数
Private NO_ As Long
Private NAME_ As String
Private X_ As Double
Private Y_ As Double
Private Z_ As Double


'コンストラクタ
Private Sub Class_Initialize()
End Sub
'デストラクタ
Private Sub Class_Terminate()
End Sub

'アクセッサ
'ゲッタ
Property Get NO() As Long
    NO = NO_
End Property

Property Get NAME() As String
    NAME = NAME_
End Property

Property Get X() As Double
    X = X_
End Property

Property Get Y() As Double
    Y = Y_
End Property

Property Get Z() As Double
    Z = Z_
End Property


'セッタ
Property Let NO(ByVal n As Long)
    If CheckNO(n) = True Then NO_ = n
End Property

Property Let NAME(ByVal s As String)
    'MAX_NAME < strlen(NAME) の場合は整形
    Call LetNameLessThanMAX_NAME(s)
End Property

Property Let X(ByVal d As Double)
    X_ = d
End Property

Property Let Y(ByVal d As Double)
    Y_ = d
End Property

Property Let Z(ByVal d As Double)
    Z_ = d
End Property

'MIN_NO < NO < MAX_NOであるかチェック
'×=falseを返す
Function CheckNO(ByVal n As Long) As Boolean

    CheckNO = False
    Select Case n
        Case Is < MIN_NO
            MsgBox "NOが小さすぎます"
        Case Is > MAX_NO
            MsgBox "NOが大きすぎます"
        '正常
        Case Else
            CheckNO = True
    End Select
End Function

'MAX_NAME < strlen(NAME) の場合は整形
Private Sub LetNameLessThanMAX_NAME(ByVal s As String)

    If MAX_NAME < Len(s) Then
        NAME_ = Left(s, MAX_NAME)
    Else
        NAME_ = s
    End If

End Sub

'SIMA行からセット
Public Sub LetBySIMA(ByVal s As String)

    Dim t As Variant
    t = Split(s, ",")

    'NO
    If CheckNO(CInt(t(0))) = True Then NO_ = CInt(t(0))

    'MAX_NAME < strlen(NAME) の場合は整形
    Call LetNameLessThanMAX_NAME(t(1))

    X_ = CDbl(t(2))
    Y_ = CDbl(t(3))
    Z_ = CDbl(t(4))

End Sub

標準モジュールです。

'標準モジュール

Option Explicit


Sub test()

    Const MAX = 10

    'Zahyoクラスで宣言
    Dim Point(1 To MAX) As Zahyo

    Dim i As Integer
    For i = 1 To MAX
        'インスタンス生成
        Set Point(i) = New Zahyo

        'こんな風にセット
        With Point(i)
            .NO = i
            .NAME = "Nm" & i
            .X = CDbl(i) + 1000#
            .Y = CDbl(i) + 1000#
            .Z = CDbl(i) + 100#
        End With
    Next i

    'SIMA行からセット
    Point(10).LetBySIMA ("999,012345678901234567,100.0,111.1,222.2")


    'ゲット
    For i = 1 To MAX
        Debug.Print Point(i).NO, Point(i).NAME, Point(i).X, Point(i).Y, Point(i).Z
    Next i


End Sub

掲載しているコードは自由に使用できますが、それによって生じたいかなる損害についても、当社は一切の責任を負いません。