谁能提供一段vb在CAD中绘制多段线的实例代码作参考！

Question

如题所述

Answer 1

多线段没画过，
线倒是画过，二话不说直接上代码你参考一下
绘制边框
Private Sub Command4_Click()
Set acadDoc = acadApp.ActiveDocument
link2
acadDoc.ActiveLayer = acadlay(0)
With adoRes
While Not .EOF
pt1(0) = !X: pt1(1) = !Y: pt1(2) = !z: pt2(0) = !X1: pt2(1) = !Y1: pt2(2) = !z1
draw pt1, pt2
.MoveNext
Wend
End With
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 20: pt2(1) = 10: pt2(2) = 0
draw pt1, pt2
'在坡
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 20: pt2(1) = 10: pt2(2) = 0
draw pt1, pt2
For c = 0 To 50 Step 10
pt1(0) = 0: pt1(1) = c: pt1(2) = 0
pt2(0) = 270: pt2(1) = c: pt2(2) = 0
draw pt1, pt2
Next c
pt1(0) = 20: pt1(1) = 0: pt1(2) = 0
pt2(0) = 20: pt2(1) = 190: pt2(2) = 0
draw pt1, pt2

pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 0: pt2(1) = -10: pt2(2) = 0
draw pt1, pt2

pt1(0) = 0: pt1(1) = -10: pt1(2) = 0
pt2(0) = 270: pt2(1) = -10: pt2(2) = 0
draw pt1, pt2
pt1(0) = 270: pt1(1) = -10: pt1(2) = 0
pt2(0) = 270: pt2(1) = 0: pt2(2) = 0
draw pt1, pt2
pt3(0) = 5: pt3(1) = -7
acadDoc.ModelSpace.AddText t, pt3, 4
pt3(0) = 55: pt3(1) = -7
acadDoc.ModelSpace.AddText t1, pt3, 4
a = 0
For c = 60 To 100 Step 10
pt1(0) = 20: pt1(1) = c: pt1(2) = 0
pt2(0) = 23: pt2(1) = c: pt2(2) = 0
draw pt1, pt2
pt1(0) = 10: pt1(1) = c - 1.6: pt1(2) = 0
acadDoc.ModelSpace.AddText a, pt1, 3.2
a = a + 2
Next c
'在图中加入地面高程
acadDoc.ActiveTextStyle = acadDoc.TextStyles.Add("楷体")
pt1(0) = 1: pt1(1) = 13: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("地面高程", pt1, 3.2)
Call rote1(acadtext, pt1)
'在图中加入设计高程
Call rote1(acadtext, pt1)
pt1(0) = 1: pt1(1) = 23: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("设计高程", pt1, 3.2)
Call rote1(acadtext, pt1)
'在图中加入填挖高
pt1(0) = 1: pt1(1) = 33: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("填 挖 高", pt1, 3.2)
Call rote1(acadtext, pt1)
'在图中加入坡度/坡长
pt1(0) = 0: pt1(1) = 5.5: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("坡 度", pt1, 3.2)
Call rote1(acadtext, pt1)
pt1(0) = 9: pt1(1) = 1: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("坡 长", pt1, 3.2)
Call rote1(acadtext, pt1)
'在图中加入桩号
pt1(0) = 1: pt1(1) = 43: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("桩 号", pt1, 3.2)
Call rote1(acadtext, pt1)
Call Command5_Click
End Sub
Private Sub draw(pt1, pt2)
Set AcadLine = acadDoc.ModelSpace.AddLine(pt1, pt2)
acadDoc.Regen acActiveViewport
End Sub
线倒是画过，二话不说直接上代码你参考一下本回答被提问者和网友采纳