選択したLINEを指定した画層にOffsetします。

・Lineを選択して連続Offset

・Lineを選択して両側にOffset

の、２パターンです。

今回もExcelVBAで、WorkSheetをｺﾝﾄﾛｰﾙ画面に使用しています。

１，Excelのbookを開いた時の自動実行

BricsCADが開かれているかの判定と、全画層名のリストを取得しｺﾝﾎﾞﾎﾞｯｸに格納します。

Excel起動時の処理コードを、Workbook_Open()のsubﾌﾟﾛｼｰｼﾞｬ内に記述します。

自動実行のコード

Private Sub Workbook_Open()

''BricsCADのオブジェクト変数を宣言
Dim BcadApp As BricscadApp.AcadApplication
Dim BcadDoc As BricscadApp.AcadDocument

''現在開いているBricsCADを取得
On Error Resume Next
Set BcadApp = GetObject(, "BricscadApp.AcadApplication")
If Err.Number <> 0 Then
    MsgBox "BricsCADが開かれていません" & vbCr & vbCr & "Excelを終了します"
    Application.Quit
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If

BcadApp.Visible = True
Set BcadDoc = BcadApp.ActiveDocument

''=====【画層一覧の取得】=====
''ComboBoxのオブジェクト変数を宣言
Dim LayObj As AcadLayer
Dim ComboBox As MSForms.ComboBox
Set ComboBox = ActiveSheet.ComboBox1
''全画層名をComboBoxLayに格納
    Dim layerNames As String
    For Each LayObj In BcadDoc.Layers
    ''全画層名のリストを取得
        layerNames = layerNames + LayObj.Name + vbCrLf
        ComboBox.AddItem LayObj.Name
    Next
''現在の画層名をｺﾝﾎﾞﾎﾞｯｸｽに格納
    ComboBox.Value = BcadDoc.ActiveLayer.Name

Set ComboBox = Nothing
Set BcadDoc = Nothing
Set BcadApp = Nothing

End Sub

2，WorkSheetの構成

部品は、フォームコントロールのボタンとActiveXコントロールのコンボボックスです。

Sheet１は連続Offset用とし、実行ボタンにModule1の連続Offse用のVBAマクロを登録

Sheet２は両側Offset用とし、実行ボタンにModule２の両側OffseのVBAマクロを登録

３，連続Offset用のVBAコード

Option Explicit

''Win32API宣言(64bit)Sleep関数
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub ContinuouslyOffset_toSpecifiedLayer()

''【BricsCADのオブジェクト変数を宣言】
Dim BcadApp As BricscadApp.AcadApplication
Dim BcadDoc As BricscadApp.AcadDocument
''現在開いているBricsCADを取得する
Set BcadApp = GetObject(, "BricscadApp.AcadApplication")
BcadApp.Visible = True
Set BcadDoc = BcadApp.ActiveDocument
''選択ｵﾌﾞｼﾞｪｸﾄ画層名
Dim ObjLyr As String
''Offset用画層名を取得
Dim SelLyr As String
SelLyr = ActiveSheet.ComboBox1.Value
'' BricsCADのキャプションを取得
Dim BcadCaption As String
BcadCaption = BcadDoc.Application.Caption
'' Excelのキャプションを取得
Dim xlApp As String
xlApp = Excel.Application.Caption

Dim SelectObj As AcadObject
Dim offsetObj As AcadObject
Dim p() As Double

'' BricsCADの画面をアクティブ
    AppActivate BcadCaption

On Error Resume Next

Call BcadDoc.Utility.GetEntity(SelectObj, p(), "図形を選択: ")

If Err Then
    Err.Clear
    On Error GoTo 0
    Set BcadApp = Nothing
    Set BcadDoc = Nothing
    '' Excelの画面をアクティブ
    AppActivate xlApp
    Exit Sub
End If

''選択ｵﾌﾞｼﾞｪｸﾄの画層名を取得
ObjLyr = SelectObj.Layer
''選択ｵﾌﾞｼﾞｪｸﾄの画層をOffset画層に変更
SelectObj.Layer = SelLyr

Dim StRow As Integer, CuRow As Integer, UpRow As Integer, EndRow As Integer
StRow = 6
CuRow = StRow
EndRow = Cells(Rows.Count, 1).End(xlUp)

Dim I As Integer, retVal As Long, retVals As Long

UpRow = CuRow

retVals = 0

For I = 1 To EndRow

retVal = Cells(UpRow, 2).Value

retVal = retVal + retVals

offsetObj = SelectObj.offset(retVal)

UpRow = CuRow + I
retVals = retVal

Next
''選択ｵﾌﾞｼﾞｪｸﾄの画層を元の画層に戻す
SelectObj.Layer = ObjLyr
''図面を更新
BcadDoc.Application.Update

    On Error GoTo 0
    Set BcadApp = Nothing
    Set BcadDoc = Nothing
    '' Excelの画面をアクティブ
    AppActivate xlApp
            
End Sub

元になる基準線を作図し、各基準線の間隔をExcelの表に記入しておきます。

Noは必須です。これでデーターの最終行を取得しています。

指定した間隔でOffsetします。
タテのLineは右方向へ、ヨコのLinehは上方向へOffsetします。
入力数値（間隔）を負（-）にすると、逆方向へoFFSERTします。

正(+)負(-)だけのOffsetが両側Offsetです。

初めは、チェックボックス選択で、１シートで両方を処理しようと考えていましたが、案外不便で別シートにしました。

４，両側Offset用のVBAコード

Option Explicit

''Win32API宣言(64bit)Sleep関数
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub BothSidesOffset_toSpecifiedLayer()

''【BricsCADのオブジェクト変数を宣言】
Dim BcadApp As BricscadApp.AcadApplication
Dim BcadDoc As BricscadApp.AcadDocument
''現在開いているBricsCADを取得する
Set BcadApp = GetObject(, "BricscadApp.AcadApplication")
BcadApp.Visible = True
Set BcadDoc = BcadApp.ActiveDocument
''選択ｵﾌﾞｼﾞｪｸﾄ画層名
Dim ObjLyr As String
''Offset用画層名
Dim SelLyr As String
SelLyr = ActiveSheet.ComboBox1.Value
'' BricsCADのキャプションを取得
Dim BcadCaption As String
BcadCaption = BcadDoc.Application.Caption
'' Excelのキャプションを取得
Dim xlApp As String
xlApp = Excel.Application.Caption

Dim SelectObj As AcadObject
Dim offsetObj As AcadObject
Dim p() As Double

'' BricsCADの画面をアクティブ
    AppActivate BcadCaption

Do

On Error Resume Next

Call BcadDoc.Utility.GetEntity(SelectObj, p(), "図形を選択: ")

If Err Then Exit Do

''選択ｵﾌﾞｼﾞｪｸﾄの画層名を取得
ObjLyr = SelectObj.Layer
''選択ｵﾌﾞｼﾞｪｸﾄの画層をOffset画層に変更
SelectObj.Layer = SelLyr
''両側へoffset
Dim retVal As Long
retVal = Cells(6, 1).Value
offsetObj = SelectObj.offset(-retVal)
retVal = Cells(6, 2).Value
offsetObj = SelectObj.offset(retVal)
''選択ｵﾌﾞｼﾞｪｸﾄの画層を元の画層に戻す
SelectObj.Layer = ObjLyr
''図面を更新
BcadDoc.Application.Update

Loop

Err.Clear
On Error GoTo 0
Set BcadApp = Nothing
Set BcadDoc = Nothing
Sleep 50
'' Excelの画面をアクティブ
AppActivate xlApp
        
End Sub

kijyun画層にある規準線をLINE1画層にoffsetします。

左の – は、数値に – を付ける必要はありません。コード内で処理しています。

続けて処理できます。終了はEscキーです。

以下続く・・・・

coffee break

今回のOffsetの検討時での経緯です。

オフセットしたLineの画層変更で、offsetObj.Layer = SelLyr　はなぜか無効でした。
CHANGEコマンドで画層変更はできましたが・・・
BcadDoc.SendCommand “_CHANGE” & vbCr & “L” & vbCr & vbCr & “P” & _
vbCr & “LA” & vbCr & SelLyr & vbCr & vbCr

今回は、SendCommandやSelectionSetsは使わないで、さらりとしたコードでできないかと考えていました。

始めに選択したLineを試しに、SelectObj.Layer = SelLyr　とすると画層変更されました。結果として、始めに選択したLineをOffset画層に変更し、Offset後に元に戻すようにしました。あと、Do～Loopでもいいんですが、今回はFor~Nextを使っています。
今後、寸法値や通り名等、動作に合わせて連続作図することも考えれますね。

画面のアクティブ化

今回はExcelの画面も動作完了時にアクティブ（最前面）にしています。

” BricsCADのキャプションを取得
Dim BcadCaption As String
BcadCaption = BcadDoc.Application.Caption
” Excelのキャプションを取得
Dim xlApp As String
xlApp = Excel.Application.Caption

操作完了後にExcelの画面が最前面になります。

” BricsCADの画面をアクティブ
AppActivate BcadCaption
” Excelの画面をアクティブ
AppActivate xlApp

Bricscad VBAを使ってみよう　INDEX

BricsCADVBAを使ってみよう[1]　VBAのｲﾝｽﾄｰﾙ

BricsCAD VBAを使ってみよう[2]　UserFormその１

BricsCAD VBAを使ってみよう[3]　UserFormその２

BricsCADVBAを使ってみよう[4]　VBAの基本コード①

BricsCAD VBAを使ってみよう[5]　VBAの基本コード②

BricsCAD VBAを使ってみよう[6]　Excelとの連携①
「BricsCAD VBA to Excel」

BricsCAD VBAを使ってみよう[7]　Excelとの連携②　
「Excel VBA to BricsCAD_1」

BricsCAD VBAを使ってみよう[8]　Excelとの連携②-2　
「Excel VBA to BricsCAD_2」

BricsCAD VBAを使ってみよう[9]　TABLEの自動作成と値入力
「BricsCAD VBA」

BricsCAD VBAを使ってみよう[10]　Excelとの連携②-3
「Excel VBA to BricsCAD_3」SerialNumber

BricsCAD VBAを使ってみよう[11]　Excelとの連携②-4
「Excel VBA to BricsCAD_4」Rectang

BricsCAD VBAを使ってみよう[12]　Excelとの連携②-5 指定画層にOffset
「Excel VBA to BricsCAD」Continuous Offset to Specified Layer

BricsCAD VBAを使ってみよう[13]　Excelとの連携②-6 指定画層にHATCH
「Excel VBA to BricsCAD」Continuous Hatch to Specified Layer

BricsCAD VBAを使ってみよう[14]　Excelとの連携②-7　長さ計測
「Excel VBA to BricsCAD」Length measurement

BricsCAD VBAを使ってみよう[15]　Excelとの連携②-8　画層状態ｺﾝﾄﾛｰﾙ
「Excel VBA to BricsCAD」layer contr

以下検討中です。

◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇
「この特集記事の内容につきましては、
こちらの環境のみの検討結果です。
動作保証は出来かねますため、ご参考
資料としてお扱いください。
Windows10（64bit）
BricsCAD pro V21（64bit）
Office2019（64bit）
◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇

テクノなブログページ

「CAD」カテゴリーアーカイブ

BricsCAD VBAを使ってみよう[12]　Excelとの連携②-5　指定画層にOffset

Bricscad VBAを使ってみよう　INDEX

Bricscad VBAを使ってみよう INDEX

Bricscad VBAを使ってみよう　INDEX