求助標示圖層LSP

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

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

x

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

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

VBA代码,供参考

4 r6 L' ?( ^, o! i! Q. x
Dim B As AcadBlock, E As AcadEntity, P As Variant, Ps(5) As Double, MT As AcadMText1 s/ L1 }: o7 z, B' U9 m/ ?
With ThisDrawing' E/ g: l. a8 }% p# @0 Q1 q
On Error GoTo 10# r- s( F1 i3 n' W# N
If .ActiveSpace = acModelSpace Then% H; k- @! a* }; a. L
Set B = .ModelSpace+ |( a: \! k/ \# V" E
Else1 ~+ S6 U8 ^' f/ H
Set B = .PaperSpace
6 k# `* C5 f- U3 R! y9 _
End If
+ g) M% Q7 ~+ ?, V: u- Q
.Utility.GetEntity E, P, vbCrLf & "选择对象:"
6 A+ P5 q- @% c/ @+ t7 s# J/ s
Ps(0) = P(0): Ps(1) = P(1): Ps(2) = P(2)4 a+ Z2 i4 ]5 U8 {( w) {7 \
P = .Utility.GetPoint(P, vbCrLf & "指定文字插入点:" )6 Q: O7 s. B/ p. q, f
Set MT = B.AddMText(P, 0, "%<\AcObjProp Object(%<\_ObjId " & E.ObjectID & ">%).Layer>%" )
8 ^5 o* |/ D6 h6 `- i/ i5 X$ J) i7 W) m
B.AddLeader Ps, MT, acLineWithArrow
* O& r; `( { `! P
10 End With4 G" @) z' I0 u0 Q M

复制代码

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

通知