【AutoCAD二次开发】第五节实体编辑

'第五节 实体编辑
Sub EditEntity() '编辑点
   Dim objPnt As AcadPoint
   Dim xy(2) As Double, xxyy(2) As Double
   xy(0) = 100: xy(1) = 200: xy(2) = 0
   xxyy(0) = 101: xxyy(1) = 201: xxyy(2) = 0
   Set objPnt = ThisDrawing.Application.ActiveDocument.ModelSpace.AddPoint(xy)
   objPnt.Thickness = 123456
   objPnt.Layer = "hello"
   objPnt.color = acGreen
   objPnt.Move xy, xxyy
   MsgBox "移动后的坐标为：(" & objPnt.Coordinates(0) & "," & objPnt.Coordinates(1) & "," & objPnt.Coordinates(2) & ")"
End Sub
Sub EditLwPolyline() '编辑轻量多段线
   Dim objLwPl As AcadLWPolyline
   Dim xy(5) As Double
   xy(0) = 100: xy(1) = 200
   xy(2) = 300: xy(3) = 300
   xy(4) = 500: xy(5) = 600
   Set objLwPl = ThisDrawing.Application.ActiveDocument.ModelSpace.AddLightWeightPolyline(xy)
   objLwPl.Closed = True '闭合
   objLwPl.ConstantWidth = 0 '全局宽度
   objLwPl.Linetype = "10421" '线型（加载了才可用）
   objLwPl.Highlight True '高亮显示
   MsgBox "ID=" & objLwPl.ObjectID
   MsgBox "类型=" & objLwPl.ObjectName
   MsgBox "句柄=" & objLwPl.Handle
   MsgBox "多段线坐标为：(" & objLwPl.Coordinates(0) & "," & objLwPl.Coordinates(1) & "),(" & objLwPl.Coordinates(2) & "," & objLwPl.Coordinates(3) & "),(" & objLwPl.Coordinates(4) & "," & objLwPl.Coordinates(5) & ")"
End Sub
Sub EditText() '编辑文字
   Dim objText As AcadText
   Dim xy(2) As Double
   xy(0) = 100: xy(1) = 200: xy(2) = 300
   Set objText = ThisDrawing.Application.ActiveDocument.ModelSpace.AddText("Hello World!", xy, 30)
   MsgBox "插入点位置:(" & objText.insertionPoint(0) & "," & objText.insertionPoint(1) & "," & objText.insertionPoint(2) & ")"
   objText.Alignment = acAlignmentBottomRight '对齐方式
   objText.height = 20 '高度
   objText.StyleName = "STANDARD" '样式
   objText.TextString = "AutoCAD VBA 测绘" '文字内容
End Sub