今回は、直線2本のDXFデータを作成します。
直線2本ができれば、2本以上も同じ考えでできます。
Sub test6()
Dim i As Long, j As Long
Dim RowEnd As Long
Dim Row_Enti As Long
Dim Xcod_S, Ycod_S
Dim Xcod_E, Ycod_E
RowEnd = Range("A1").End(xlDown).Row
For j = 1 To RowEnd
If Cells(j, 1) = "ENTITIES" Then
Row_Enti = j
Exit For
End If
Next j
With Worksheets("座標と番号")
For i = 1 To 3
X(i) = .Cells(i, "A").Value
Y(i) = .Cells(i, "B").Value
Next i
For i = 1 To 2
Xcod_S = X(.Cells(i, "D").Value)
Ycod_S = Y(.Cells(i, "D").Value)
Xcod_E = X(.Cells(i, "E").Value)
Ycod_E = Y(.Cells(i, "E").Value)
Call LineDraw(RowEnd, Row_Enti, Xcod_S, Ycod_S, Xcod_E, Ycod_E)
RowEnd = Range("A1").End(xlDown).Row
Next i
End With
End Sub
サブプロシージャ LineDrawは前回と同じです。
(ワークシートは指定しました)
Sub LineDraw(RowEnd, Row_Enti, Xcod_S, Ycod_S, Xcod_E, Ycod_E)
Dim EntyData(16)
Dim LineTyp_code As String
Dim LineCol_code As Long
Dim i As Long
Dim j As Long
Dim Row_EndSec As Long
Dim cnt As Long
LineTyp_code = "CONTINUOUS"
LineCol_code = 7
EntyData(1) = 0
EntyData(2) = "LINE"
EntyData(3) = 8
EntyData(4) = "_0-0_"
EntyData(5) = 6
EntyData(6) = LineTyp_code
EntyData(7) = 62
EntyData(8) = LineCol_code
EntyData(9) = 10
EntyData(10) = Xcod_S
EntyData(11) = 20
EntyData(12) = Ycod_S
EntyData(13) = 11
EntyData(14) = Xcod_E
EntyData(15) = 21
EntyData(16) = Ycod_E
With Worksheets("原紙")
For i = Row_Enti + 1 To RowEnd
If .Cells(i, 1) = "ENDSEC" Then
Row_EndSec = i
cnt = 0
For j = 1 To 16
.Cells(Row_EndSec + cnt - 1, 1).EntireRow.Insert
.Cells(Row_EndSec + 1 + cnt - 2, 1).Value = EntyData(j)
cnt = cnt + 1
Next j
End If
Next i
End With
End Sub
座標のデータをX(i),Y(i)に入れます。
元データは、ワークシート(座標と番号)に入れときます。
Xcod_S = X(.Cells(i, "D").Value) ・・・・
のところで、直線の始点、終点の座標を取得しています。
取得する、節点番号を、先のワークシートから取得します。
後は、前回と同様に、ENTITIESセクションに入れていきます。
詳細は、動画の中で解説しましたので参考にして下さい。