CAD二次开发 VBA 如何读取图元属性 坐标 并输出到文本

2024-10-28 16:11:22
推荐回答(1个)
回答(1):

 Set acadApp = GetObject("autocad.application")
 If Err Then
 Err.Clear
 Set acadApp = CreateObject("autocad.application")
 If Err Then
 MsgBox ("不能运行CAD,请检查是否安装")
 Exit Sub
 End If
 End If
 acadApp.Visible = False
cadApp.Documents.Open filename, True  '打开一个图
Dim Lt As AcadLayer
Dim uCircle As AcadCircle
Dim cen(0 To 2) As Double
 Dim obj As AcadObject
 Dim CC As Variant
 Dim i As Integer, t As Integer
 Dim Repeat As Boolean  '检测是否重复
 On Error GoTo err_0
  Me.MousePointer = 11
 i = 1
 txtcir.Clear
 Listcir.Clear
 Listprog.Clear
 'For Each Lt In acadApp.ActiveDocument.Layers
     
     For Each obj In acadApp.ActiveDocument.ModelSpace
     
  ' Debug.Print obj.ObjectName & "  Layer:" & Lt.Name
      
      If LCase(obj.ObjectName) = "acdbcircle" Then
       Set uCircle = obj
    '    ' MsgBox obj.ObjectName
      If uCircle.Layer = Trim(Layer) Then
    CC = uCircle.Center
     Repeat = False
     
     '取x,y最大值
     If CC(0) > x_max Then x_max = CC(0)
     If CC(1) > y_max Then y_max = CC(1)
     If uCircle.Diameter > d_max Then d_max = uCircle.Diameter

自己补全吧