Dim Acad
'Acad変数はErサブルーチンでも使うのでここで宣言
Call Main 'Mainサブルーチンコール
'選択した直線を50mm平行移動
Sub Main()
'AcadRemoconオブジェクト作成
Set Acad = CreateObject("AcadRemocon.Body")
'図形選択→DXFファイル書き出し(ロックされた画層で描かれた図形は選択不可)
If Not Acad.acDxfOut("線分を選択", "", False) Then Er: Exit Sub
'DXFファイルからLINEオブジェクトを抽出(10=始点X座標のグループコード,11=終点X座標のグループコード)
If Not Acad.DxfExtract(Cnt, ExtArr, "ENTITIES", "", "LINE", "10|11") Then Er: Exit Sub
'抽出数が0なら終了
If Cnt = 0 Then Exit Sub
'始点と終点のX座標を50mmずらす
For i = 1 To Cnt: ExtArr(1, i) = ExtArr(1, i) + 50:
ExtArr(2, i) = ExtArr(2, i) + 50:
Next
'配列への変更をDXFファイルに反映
If Not Acad.DxfUpdate(ExtArr) Then Er: Exit Sub
'DXFIN実行
If Not Acad.acDxfIn() Then Er: Exit Sub
'直前の選択セットを削除
If Not Acad.acPostCommand("ERASE P^M^M") Then Er: Exit Sub
End Sub
'エラー処理
Sub Er()
'ユーザーによるキャンセル
If Acad.ErrNumber = vbObjectError + 1000 Then
'ここにキャンセル時の処理を追加
'
Else
'エラー内容表示
Acad.ShowError
End If
End Sub |