1.遍历图层
Dim layer As AcadLayer For Each layer In ThisDrawing.Layers Next layer 2.获取指定图层
Dim CurrentLayer As AcadLayer Set CurrentLayer = ThisDrawing.Layers.Item(\"层名(或序号)\") 3.选择集构建(选择指定图层的文本对象) Dim acadApp As AcadApplication Dim acadDoc As AcadDocument
Private Sub Command1_Click() On Error Resume Next Set acadApp = GetObject(, \"AutoCAD.Application\") If Err Then Err.Clear Set acadApp = CreateObject(\"AutoCAD.Application\") End If
Set acadDoc = acadApp.ActiveDocument
Dim FType(0 To 1) As Integer Dim FData(0 To 1) As Variant
FType(0) = 0
FData(0) = \"TEXT\"
FType(1) = 8
FData(1) = \"GCJZ\"
Dim etobj As AcadSelectionSet Set etobj = acadDoc.SelectionSets.Add(\"test2\")
etobj.Select acSelectionSetAll, , , FType, FData
For Each pickedobjs In etobj pickedobjs.Color = acGreen
\'把选上的实体变成绿色 pickedobjs.Update Next etobj.Delete 4.遍历选择集
Dim ent As AcadEntity Dim color As New AcadAcCmColor color.ColorIndex = acRed For Each ent In ThisDrawing.ModelSpace If TypeOf ent Is AcadLine Then ent.TrueColor = color End If Next ent 5.动态创建多线段
Sub CreatePolylineBasic() On Error Resume Next Dim index As Integer index = 2
Dim pt1 As Variant pt1 = ThisDrawing.Utility.GetPoint(, \"输入第一点：\") If Err Then Err.Clear Exit Sub End If
Dim ptPrevious As Variant, ptCurrent As Variant ptPrevious = pt1
NEXTPOINT: ptCurrent = ThisDrawing.Utility.GetPoint(ptPrevious, \"输入下一点：\") If Err Then Err.Clear Exit Sub End If
Dim objPline As AcadLWPolyline If index = 2 Then Dim points(0 To 3) As Double points(0) = ptPrevious(0) points(1) = ptPrevious(1) points(2) = ptCurrent(0) points(3) = ptCurrent(1) Set objPline = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) ElseIf index > 2 Then Dim ptvert(0 To 1) As Double ptvert(0) = ptCurrent(0) ptvert(1) = ptCurrent(1) objPline.AddVertex index - 1, ptvert End If index = index + 1 ptPrevious = ptCurrent GoTo NEXTPOINT End Sub 6.获取DXF组码 直接在命令行输入(entget(car(entsel))),或者在函数中ThisDrawing.SendCommand “(entget(car(entsel)))” 7.
