求助標示圖層LSP

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

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

x

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

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

VBA代码,供参考

' r! {* `2 C7 a5 P( ?1 O! U3 r; {
Dim B As AcadBlock, E As AcadEntity, P As Variant, Ps(5) As Double, MT As AcadMText9 b4 L+ r2 |2 Z/ f2 K
With ThisDrawing6 B3 W/ e! S9 e1 M ^5 g6 [; z
On Error GoTo 10
) x/ J: ?$ F0 G8 w; s8 K& f
If .ActiveSpace = acModelSpace Then
+ |! o$ B; j. [+ h# s
Set B = .ModelSpace
3 D/ E4 H$ |% Y9 V$ A
Else! c; I) P2 @: J5 U; i
Set B = .PaperSpace/ y9 N! o. ^& s0 k% v- }
End If& c) Y* o1 k- C: E
.Utility.GetEntity E, P, vbCrLf & "选择对象:"
/ L2 ~4 d0 u! D1 G$ Q; L7 ~
Ps(0) = P(0): Ps(1) = P(1): Ps(2) = P(2)7 u- ]3 b( u3 ~0 J; ~
P = .Utility.GetPoint(P, vbCrLf & "指定文字插入点:" )
5 {9 d$ d7 A3 e* T( U+ m
Set MT = B.AddMText(P, 0, "%<\AcObjProp Object(%<\_ObjId " & E.ObjectID & ">%).Layer>%" )
4 f' F) D% i- i2 V$ Z
B.AddLeader Ps, MT, acLineWithArrow1 `& ?- P1 H% ~8 C4 r% K! h
10 End With
* ]# [5 Y7 |/ I

复制代码

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

通知