'第一节 HelloWorld
Sub HelloWorld()
MsgBox "Hello World!", vbInformation, "我的第一个程序"
End Sub
'第二节 SendCommand调用AutoCAD命令
Sub DrawLine() '绘制直线
ThisDrawing.Application.ActiveDocument.SendCommand "line" & vbCr & "0,0" & vbCr & "1,1" & vbCr & Chr(27)
End Sub
Sub DarwYancong() '绘制烟囱
ThisDrawing.Application.ActiveDocument.SendCommand "dd" & vbCr & "152700" & vbCr & "0,0" & vbCr
End Sub
'第三节 点、线、圆、文字的绘制
Sub DrawPoint() '绘制点
Dim xy(2) As Double
xy(0) = 100: xy(1) = 200: xy(2) = 0
ThisDrawing.Application.ActiveDocument.ModelSpace.AddPoint xy
ThisDrawing.Application.ZoomCenter xy, 1
ThisDrawing.Application.ActiveDocument.SetVariable "PDMODE", 35
ThisDrawing.Application.ActiveDocument.SetVariable "PDSIZE", 5
End Sub
Sub DrawLwPolyline() '绘制轻量多段线
Dim xy(3) As Double
xy(0) = 100: xy(1) = 200
xy(2) = 300: xy(3) = 400
ThisDrawing.Application.ActiveDocument.ModelSpace.AddLightWeightPolyline xy
End Sub
Sub DrawPolyline() '绘制多段线
Dim xy(5) As Double
xy(0) = 100: xy(1) = 200: xy(2) = 25
xy(3) = 300: xy(4) = 400: xy(5) = 25
ThisDrawing.Application.ActiveDocument.ModelSpace.AddPolyline xy
End Sub
Sub DrawPolyline2() '绘制多段线并修改高程
Dim objPL As AcadPolyline
Dim xy(5) As Double
xy(0) = 100: xy(1) = 200: xy(2) = 25
xy(3) = 300: xy(4) = 400: xy(5) = 25
Set objPL = ThisDrawing.Application.ActiveDocument.ModelSpace.AddPolyline(xy)
objPL.Elevation = 25
End Sub
Sub DrawCircle() '绘制圆
Dim xy(2) As Double
xy(0) = 100: xy(1) = 200: xy(2) = 300
ThisDrawing.Application.ActiveDocument.ModelSpace.AddCircle xy, 20
End Sub
Sub DrawText() '绘制文本
Dim xy(2) As Double
xy(0) = 100: xy(1) = 200: xy(2) = 300
ThisDrawing.Application.ActiveDocument.ModelSpace.AddText "Hello World!", xy, 30
End Sub
全部评论