求助標示圖層LSP

BILL.PU · 发表于 2009-11-16 21:01:37

您需要登录才可以下载或查看，没有帐号？注册

x

線上大大们,求助，標示圖層
如圖把圖層一一標示出來
謝謝!!

woaishuijia · 发表于 2009-12-11 20:30:58

VBA代码,供参考

! O- X- ^2 C; x: O# k, i6 o0 V
Dim B As AcadBlock, E As AcadEntity, P As Variant, Ps(5) As Double, MT As AcadMText
2 i/ }) G9 M! E0 I8 z: A5 _
With ThisDrawing
: o8 c2 v: X; N- ~4 S$ |
On Error GoTo 10
+ ]3 K+ D0 c4 h/ s8 o) o
If .ActiveSpace = acModelSpace Then
4 \# W7 S4 s) q: H5 j" c7 Q3 Y# X
Set B = .ModelSpace/ Q( X3 c' G+ _4 ~4 D4 |
Else
& q# A; F6 L, S! N( x; C1 C
Set B = .PaperSpace
2 t( N- B: |- |! f( h
End If
) H2 h9 y: y# ^' [0 o+ T
.Utility.GetEntity E, P, vbCrLf & "选择对象:"& V* K# S3 S9 f6 p. G" u
Ps(0) = P(0): Ps(1) = P(1): Ps(2) = P(2)6 P6 L y$ L9 ?$ l/ {2 ~
P = .Utility.GetPoint(P, vbCrLf & "指定文字插入点:" )' J) G6 Q9 O: ?. A6 B
Set MT = B.AddMText(P, 0, "%<\AcObjProp Object(%<\_ObjId " & E.ObjectID & ">%).Layer>%" )
' E0 h. O1 E* w3 o
B.AddLeader Ps, MT, acLineWithArrow
* i2 S" h/ a+ W l1 I7 u3 F; y0 \
10 End With
/ o! @" u" \- \8 F7 g0 @

复制代码

		自动登录	找回密码
密码			注册

通知