这个必须用控件的方法解决,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
'祝你成功!