|
|
发表于 2009-12-11 20:30:58
|
显示全部楼层
来自: 中国
VBA代码,供参考
2 J" _4 K$ F7 w$ c5 o" S: n- Dim B As AcadBlock, E As AcadEntity, P As Variant, Ps(5) As Double, MT As AcadMText$ U+ A/ ^; z6 \# R
- With ThisDrawing1 O6 U" M7 E; k- B( k6 h
- On Error GoTo 10
3 P6 @' S; h" Y: K9 _ J9 e+ p - If .ActiveSpace = acModelSpace Then+ @8 Y5 h1 C! n
- Set B = .ModelSpace
; q* m+ L2 O9 v5 ?6 N& O: h6 k0 d3 e" s8 ~ - Else
0 E8 A4 _5 ~" g - Set B = .PaperSpace! G3 Q. `0 `, l9 y
- End If
5 ^) _- d( ]3 U* L; ~9 a - .Utility.GetEntity E, P, vbCrLf & "选择对象:"
2 r' E8 s" G0 D - Ps(0) = P(0): Ps(1) = P(1): Ps(2) = P(2)
7 Y1 }7 H" j. D - P = .Utility.GetPoint(P, vbCrLf & "指定文字插入点:" )
9 N; e3 Y& N1 H7 j - Set MT = B.AddMText(P, 0, "%<\AcObjProp Object(%<\_ObjId " & E.ObjectID & ">%).Layer>%" )
% \4 U( m! H/ b' J. W l - B.AddLeader Ps, MT, acLineWithArrow; u3 ^2 `; \" c2 V1 j+ r
- 10 End With
; V2 {2 ^% A7 j \, L$ I- _
复制代码 |
|