Dim Acad  'Acad変数はErサブルーチンでも使うのでここで宣言
Call Main 'Mainサブルーチンコール

'図面内のすべての直線のX座標を50mm平行移動(ロック画層対応版)
Sub Main()
    'AcadRemoconオブジェクト作成
    Set Acad = CreateObject("AcadRemocon.Body")
    '図面全体をDXFファイルに書き出し（ロック画層で描かれた図形も含む）
    If Not Acad.acDxfOut("", "DWG") 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.acSaveLayerState() Then Er: Exit Sub
    '画層ロック解除（ロック画層で描かれた図形は削除出来ないので）
    If Not Acad.acPostCommand("-LAYER U *^M^M") Then Er: Exit Sub
    '直前の選択セットを削除
    If Not Acad.acPostCommand("ERASE P^M^M") Then Er: Exit Sub
    '画層の状態を復元
    If Not Acad.acLoadLayerState() Then Er: Exit Sub
End Sub

'エラー処理
Sub Er()
    'ユーザーによるキャンセル
    If Acad.ErrNumber = vbObjectError + 1000 Then
        'ここにキャンセル時の処理を追加
        '
    Else
        'エラー内容表示
        Acad.ShowError
    End If
End Sub