求助：块插入点问题

alin

你要通过拾取圆来得到坐标呢还是其它什么方法，也可以上张图。

liuyang4740

不是！我想通过for each 命令自动搜索所有的块参照，然后自动获取圆心

alin

对于二维的情况，可以试用下面的代码，只要把块名haha更换

3. 'Option Explicit
4. Sub test()
5. Dim blkDef As AcadBlock
6. Dim objEnt As AcadEntity
7. Dim center As Variant
8. Dim InsPnt As Variant
9. Set blkDef = ThisDrawing.Blocks("haha")
10. For Each objEnt In blkDef
11.     If objEnt.ObjectName = "AcDbCircle" Then
12.       center = objEnt.center
13.       xc = center(0): yc = center(1)
14.     End If
15. Next
16. For Each objEnt In ThisDrawing.ModelSpace
17.    If objEnt.ObjectName = "AcDbBlockReference" Then
18.      If objEnt.Name = "haha" Then
19.        InsPnt = objEnt.InsertionPoint
20.        rot = objEnt.Rotation
21.        x_scale = objEnt.XScaleFactor
22.        y_scale = objEnt.YScaleFactor
23.        new_x = Cos(rot) * x_scale * xc - Sin(rot) * y_scale * yc + InsPnt(0)
24.        new_y = Sin(rot) * x_scale * xc + Cos(rot) * y_scale * yc + InsPnt(1)
25.        MsgBox new_x & ", " & new_y
26.     End If
27.     End If
28. Next

'Option Explicit Sub test() Dim blkDef As AcadBlock Dim objEnt As AcadEntity Dim center As Variant Dim InsPnt As Variant Set blkDef = ThisDrawing.Blocks("haha") For Each objEnt In blkDef     If objEnt.ObjectName = "AcDbCircle" Then       center = objEnt.center       xc = center(0): yc = center(1)     End If Next For Each objEnt In ThisDrawing.ModelSpace    If objEnt.ObjectName = "AcDbBlockReference" Then      If objEnt.Name = "haha" Then        InsPnt = objEnt.InsertionPoint        rot = objEnt.Rotation        x_scale = objEnt.XScaleFactor        y_scale = objEnt.YScaleFactor        new_x = Cos(rot) * x_scale * xc - Sin(rot) * y_scale * yc + InsPnt(0)        new_y = Sin(rot) * x_scale * xc + Cos(rot) * y_scale * yc + InsPnt(1)        MsgBox new_x & ", " & new_y     End If     End If Next

liuyang4740

非常感谢版主！问题解决了！