189 8069 5689
这个必须用控件的方法解决，VB6有个Line控件很容易解决这个问题，但是VB.NET没有了，幸好微软也想到了这个缺陷，提供免费的Visual Basic PowerPacks控件箱，其中有Line控件。
成都创新互联公司成立于2013年，我们提供高端成都网站建设、成都网站制作、成都网站设计公司、网站定制、营销型网站建设、微信小程序、微信公众号开发、网站推广服务，提供专业营销思路、内容策划、视觉设计、程序开发来完成项目落地，为成都木托盘企业提供源源不断的流量和订单咨询。
Visual Basic PowerPacks下载地址：
使用 LineShape 控件绘制直线：
你去查查书吧，书上挺详细的，在这说不好说，你先在项目里引用。然后 Dim acadapp As AcadApplication Dim acaddoc As AcadDocument On Error Resume Next AcadApp = GetObject(, "AutoCAD.Application") If Err.Number Then Err.Clear() AcadApp = CreateObject("AutoCAD.Application") If Err.Number Then MsgBox("不能运行AutoCAD,请检查是否安装了AutoCAD") Exit Sub End If End If AcadApp.Visible = True '界面可视
On Error Resume Next
Set ACADApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set ACADApp = GetObject(, "AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
Set ACADApp = GetObject(, "AutoCAD.Application")
Set ThisDrawing = ACADApp.ActiveDocument
Dim Pline As AcadLine
Dim ptSt(0 To 2) As Double
Dim ptEn(0 To 2) As Double
ptSt(0) = 100
ptSt(1) = 100
ptSt(2) = 0
ptEn(0) = 150
ptEn(1) = 100
ptEn(2) = 0
Set Pline = ThisDrawing.ModelSpace.AddLine(ptSt, ptEn)
VBA绘制的话，我只有绘制椭圆的时候才使用，因为椭圆分割后，发现VBA的计算角度才正确，autolisp计算的角度会有问题，查看属性会发现有偏差。
autolisp里面的entmake函数绘制速度很快，
1、直线
(entmake
(list
'(0
.
"LINE")
(cons
10
pt1)
(cons
11
pt2)))
2、两顶点多段线（多顶点类似）
(entmake
(list
'(0
.
"LWPOLYLINE")
'(100
.
"AcDbEntity")
'(100
.
"AcDbPolyline")
(cons
90
2)
(cons
10
pt1)
(cons
10
pt2)))
3、点表生成多段线
(entmake
(append
(list
'(0
.
"LWPOLYLINE")
'(100
.
"AcDbEntity")
'(100
.
"AcDbPolyline")
(cons
90
(length
lst)))
(mapcar
'(lambda
(pt)(cons
10
pt))
lst
)))
4、圆
(entmake
(list
'(0
.
"CIRCLE")
(cons
10
pt)
(cons
40
r)))
5、圆弧
(entmake
(list
'(0
.
"ARC")
(cons
10
pt)
(cons
40
r)
(cons
50
ang1)
(cons
51
ang2)))
必要的话，可以加入图层，颜色等元素，不用关闭捕捉，改变图层等。你可以试试。
绘图是系统内部操作的，不需要懂原理
方法就在那里，只有会用和不会用，你的代码告诉它绘制，它就会绘制。它（方法）究竟如何去绘制的并不是重点，反正它会绘制。
drawline（绘线）方法很简单，第一个参数是pen,它确定线条的颜色、宽度和样式。第二、第三个参数都是point类型，确定两个点的位置，绘制直线。
Set LineObj = activeDoc.ModelSpace.AddLine(startpoint, endpoint) '画线中的参数只需两个点，而你的数组是多点的，不匹配。要画多点连续线可用Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线 。
要分段线可以渐次画出。
sub 划线（）'作为一模块
Dim myAcadApp As AutoCAD.AcadApplication
Dim activeDoc As AutoCAD.AcadDocument
Dim acMS As AutoCAD.AcadModelSpace
On Error Resume Next
Set myAcadApp = GetObject(, "Autocad.Application") '检查AutoCAD是否已经打开
If Err 0 Then '没有打开
Err.Clear
Set myAcadApp = CreateObject("Autocad.Application") '打开CAD
If Err Then
MsgBox Err.Number ":" Err.Description '打开失败
Exit Sub
End If
End If
On Error GoTo prcERR
myAcadApp.Visible = True '显示CAD
Set activeDoc = myAcadApp.ActiveDocument
Dim startpoint(0 To 2) As Double '12 改为2，AddLine首尾点坐标要3维的，平面z不用赋值，默认为0
Dim endpoint(0 To 2) As Double
Dim LineObj As AcadLine
For i = 0 To 5
startpoint(0 = 0
startpoint( 1) = 2 * i
endpoint(0) = 2 * i
endpoint( 1) = 2 * i
'Next i ‘移到下一行，
Set LineObj = activeDoc.ModelSpace.AddLine(startpoint, endpoint) '画线
Next i '到此返回，实现渐次划线
prcExit:
Set activeDoc = Nothing
Set myAcadApp = Nothing
Exit Sub
prcERR:
MsgBox Err.Number ":" Err.Description, vbCritical, "错误"
Resume prcExit
End Sub
'祝你成功！