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 = FalsecadApp.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自己补全吧