前回の
BricsCAD VBAを使ってみよう[7]　Excelとの連携②
からの続篇です

前回は、ExcelVBAでBricsCADと連携する場合で、図形の面積値をExcelのシートに取得するVBAを検討しました。
今回は、Excelのシートのデーターから作図を行うVBAで、チャンネル鋼（溝形鋼）の作図を検討しました。

１，基本設定

1-1，ExcelVBEでの設定

新たなWorkBookで作成する場合は、BricsCADのタイプライブラリを使えるように、ExcelのVBE画面で参照設定を行います。

「BricscadApp Type Library 20.0」と「BricscadDbApp Type Library 20.0
」の２か所をチェックし登録します。

 

２，エクセルシートから作図データー取得

２-1，溝形鋼作図用シート

概要

Excelシートの規格表の対象個所のセルをアクティブにして、作図実行ボタン。
（Noのセルかその行の規格数値のセルを選択）

閉じたポリラインで作図します。

Excelシートの規格値は必要なものだけですので、応じて追加してください。

２-2，溝形鋼作図のVBA

Option Explicit

Sub DrawChannelSteel()

''===================================================
''================  溝形鋼作図  =====================
''===================================================

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

On Error Resume Next

''【BricsCADを取得する】
Set BcadApp = GetObject(, "BricscadApp.AcadApplication")

''BricsCADが開かれていない場合は新規に作成する
    If Err.Number <> 0 Then
        ''Errオブジェクトをクリア
        Err.Clear
        ''新規にBricsCADのインスタンスを生成
        Set BcadApp = CreateObject("BricscadApp.AcadApplication")
    End If
    BcadApp.Visible = True
    
Set BcadDoc = BcadApp.ActiveDocument

'' BricsCADのキャプションを取得
Dim BcadCaption As String
BcadCaption = BcadDoc.Application.Caption
'' BricsCADの画面をアクティブ
AppActivate BcadCaption
BcadDoc.SetVariable "FILLETRAD", 0

''現在のフィレット半径を取得
Dim CurFRad As Double
CurFRad = BcadDoc.GetVariable("FILLETRAD")
''回転角度
Dim RAng As Double
''回転中心座標
Dim RPt(0 To 2) As Double

''選択セルの行を取得
Dim Sr As Integer, Sc As Integer
Sr = Selection.Row
''アクティブセルが9行目以下の場合
If Sr < 10 Then MsgBox "規格表内を選択してください。": Exit Sub
''選択した規格値を取得
Dim H As Double, B As Double, t1 As Double, t2 As Double, r1 As Double, r2 As Double
H = Cells(Sr, 2).Value
B = Cells(Sr, 3).Value
t1 = Cells(Sr, 4).Value
t2 = Cells(Sr, 5).Value
r1 = Cells(Sr, 6).Value
r2 = Cells(Sr, 7).Value

''==================作図処理開始=========================

On Error Resume Next

''作図開始点を取得
Dim pt() As Double, Xs As Double, Ys As Double
    pt = BcadDoc.Utility.GetPoint(, "図形挿入点をクリック:")

    ''ｷｬﾝｾﾙの場合
        If Err.Number <> 0 Then
        
            GoTo ErrLine
        
        End If

''======Zoom======
Dim ZPt1(0 To 2) As Double
Dim ZPt2(0 To 2) As Double
ZPt1(0) = pt(0) - 10: ZPt1(1) = pt(1) - 10: ZPt1(2) = 0
ZPt2(0) = pt(0) + H + 10: ZPt2(1) = pt(1) + B + 10: ZPt2(2) = 0
ZoomWindow ZPt1, ZPt2


Dim LWPobj As AcadLWPolyline
Dim LinObj As AcadLine

''======①ライトウエイトポリライン作図=======

''１線目をポリラインで作図し以降はFILLETする
Dim LWpt(0 To 3) As Double
LWpt(0) = pt(0): LWpt(1) = pt(1)
LWpt(2) = pt(0): LWpt(3) = pt(1) + B
Set LWPobj = BcadDoc.ModelSpace.AddLightWeightPolyline(LWpt)

''=======②ライン作図========
Dim Pt2(0 To 2) As Double
Dim Pt3(0 To 2) As Double
Pt2(0) = pt(0): Pt2(1) = pt(1) + B: Pt2(2) = 0
Pt3(0) = pt(0) + t2: Pt3(1) = pt(1) + B: Pt3(2) = 0
Set LinObj = BcadDoc.ModelSpace.AddLine(Pt2, Pt3)
''ライン①とライン②をフィレット
BcadDoc.SendCommand "_FILLET " & LWpt(0) & "," & (LWpt(1) + LWpt(3)) / 2 & vbCr & _
(Pt2(0) + Pt3(0)) / 2 & "," & Pt2(1) & vbCr

''=======③ライン作図========
Dim Pt4(0 To 2) As Double
Pt4(0) = pt(0) + t2: Pt4(1) = pt(1) + t1: Pt4(2) = 0
Set LinObj = BcadDoc.ModelSpace.AddLine(Pt3, Pt4)
''回転
    RAng = 5
    ''回転基点
        RPt(0) = pt(0) + t2: RPt(1) = pt(1) + B / 2: RPt(2) = 0
    ''図形回転
        LinObj.Rotate RPt, RAng * ((4 * Atn(1) / 180))
''ライン②とライン③をフィレット
BcadDoc.SetVariable "FILLETRAD", r2
BcadDoc.SendCommand "_FILLET " & pt(0) & "," & pt(1) + B & vbCr & _
RPt(0) & "," & RPt(1) & vbCr
BcadDoc.SetVariable "FILLETRAD", 0

''=======④ライン作図========
Dim Pt5(0 To 2) As Double
Pt5(0) = pt(0) + H - t2: Pt5(1) = pt(1) + t1: Pt5(2) = 0
Set LinObj = BcadDoc.ModelSpace.AddLine(Pt4, Pt5)
''ライン③とライン④をフィレット
BcadDoc.SetVariable "FILLETRAD", r1
BcadDoc.SendCommand "_FILLET " & RPt(0) & "," & RPt(1) & vbCr & _
Pt4(0) + H / 2 & "," & Pt4(1) & vbCr
BcadDoc.SetVariable "FILLETRAD", 0

''=======⑤ライン作図========
Dim Pt6(0 To 2) As Double
Pt6(0) = pt(0) + H - t2: Pt6(1) = pt(1) + B: Pt6(2) = 0
Set LinObj = BcadDoc.ModelSpace.AddLine(Pt5, Pt6)
''回転
    RAng = -5
    ''回転基点
        RPt(0) = pt(0) + H - t2: RPt(1) = pt(1) + B / 2: RPt(2) = 0
    ''図形回転
        LinObj.Rotate RPt, RAng * ((4 * Atn(1) / 180))
''ライン④とライン⑤をフィレット
BcadDoc.SetVariable "FILLETRAD", r1
BcadDoc.SendCommand "_FILLET " & Pt5(0) - H / 2 & "," & Pt5(1) & vbCr & _
RPt(0) & "," & RPt(1) & vbCr
BcadDoc.SetVariable "FILLETRAD", 0

''=======⑥ライン作図========
Dim Pt7(0 To 2) As Double
Dim Pt8(0 To 2) As Double
Pt7(0) = pt(0) + H - t2: Pt7(1) = pt(1) + B: Pt7(2) = 0
Pt8(0) = pt(0) + H: Pt8(1) = pt(1) + B: Pt8(2) = 0
Set LinObj = BcadDoc.ModelSpace.AddLine(Pt7, Pt8)
''ライン⑤とライン⑥をフィレット
BcadDoc.SetVariable "FILLETRAD", r2
BcadDoc.SendCommand "_FILLET " & RPt(0) & "," & RPt(1) & vbCr & _
Pt7(0) + t2 / 2 & "," & Pt7(1) & vbCr
BcadDoc.SetVariable "FILLETRAD", 0

''=======⑦ライン作図========
Dim Pt9(0 To 2) As Double
Dim Pt10(0 To 2) As Double
Pt9(0) = pt(0) + H: Pt9(1) = pt(1) + B: Pt9(2) = 0
Pt10(0) = pt(0) + H: Pt10(1) = pt(1): Pt10(2) = 0
Set LinObj = BcadDoc.ModelSpace.AddLine(Pt9, Pt10)

''ライン⑥とライン⑦をフィレット
BcadDoc.SendCommand "_FILLET " & pt(0) + H - t2 / 5 & "," & pt(1) + B & vbCr & _
pt(0) + H & "," & pt(1) + B / 2 & vbCr

''=======⑧ライン作図========
Dim Pt11(0 To 2) As Double
Dim Pt12(0 To 2) As Double
Pt11(0) = pt(0): Pt11(1) = pt(1): Pt11(2) = 0
Pt12(0) = pt(0) + H: Pt12(1) = pt(1): Pt12(2) = 0
Set LinObj = BcadDoc.ModelSpace.AddLine(Pt11, Pt12)
''ライン⑦とライン⑧をフィレット
BcadDoc.SendCommand "_FILLET " & pt(0) + H & "," & pt(1) + B / 2 & vbCr & _
pt(0) + H / 2 & "," & pt(1) & vbCr

''フィレット半径を元に戻す
BcadDoc.SetVariable "FILLETRAD", CurFRad

''ポリラインを閉じる
LWPobj.Closed = True

''ポリライン図形を更新する
LWPobj.Update

ErrLine:

    Range("A8").Activate
    Err.Clear
    On Error GoTo 0
    Set LWPobj = Nothing
    Set LinObj = Nothing
    Set BcadDoc = Nothing
    Set BcadApp = Nothing
    
    Exit Sub

End Sub

概要

作図は、①で、まずポリラインを作図し、順次ラインを作図してフィレットしながら、連続したポリラインにします。

①②から順に②③、③④・・・とフィレットします。

作図図形が小さいと、特に⑥⑦ラインがフィレットされません。
その為、作図時に作図図形範囲にズームします。

次回は、CAD画面のTABLEを使って、前回の面積取得と同様にTABLEのセルに、取得した面積値を自動入力することを検討しました、

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

 

coffee break

今回は、以前のポリライン描画とは異なった方法の。出角・入角でR付きの連続したポリライン描画として、チャンネル鋼（溝形鋼）の作図を検討しました。
検討中はフィレット箇所が、にゃんこの手みたいになったり今一でしたが、作図範囲をZoomすると作図できました。
作図時のZoomは状況に応じて必要ですね。

BricsCAD VBAを使ってみよう　INDEX

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

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

BricsCAD VBAを使ってみよう[3]　UserFormその２
「BricsCAD VBA 」SerialNumber drawing with UserForm

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

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

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

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

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

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

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

BricsCAD VBAを使ってみよう[11]　Excelとの連携②-4 
「Excel VBA to BricsCAD」Draw_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

 

以下検討中です。

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