- UID
- 737740
- 积分
- 62
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2014-9-20
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
目前有一串代码,选择线附近文字,有几个缺点,麻烦论坛改善,谢谢!缺点:1.只能选择多段线附近文字;2.文字与线的距离不可调速;3.只能选择一条线附近的文字,不能选择多条线;4.只能选择视图内的文字,超出视图的文字不能选择。
(defun c:xw()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (progn
(princ "\n请选取多段线:")
(setq ssa (ssget ":S" '((0 . "lwpolyline,pline"))))
)
(progn
(setq ent (ssname ssa 0))
(setq dxf (entget ent))
(setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) dxf)))
(setq ptmin (mapcar '+ (apply 'mapcar (cons 'min pts)) '(-1 -1)))
(setq ptmax (mapcar '+ (apply 'mapcar (cons 'max pts)) '( 1 1)))
(if (setq ssb (ssget "w" ptmin ptmax '((1 . "架*[0-9],卡*[0-9],吊*[0-9],挂*[0-9],埋*[0-9],留*[0-9],测*[0-9],钢*[0-9],钉*[0-9],引*[0-9]"))))
(progn
(setq i 0)
(setq n (sslength ssb))
(setq jgb nil)
(repeat n
(setq entt (ssname ssb i))
(setq dxft (entget entt))
(setq pt (cdr (assoc 10 dxft)))
(setq str (cdr (assoc 1 dxft)))
(setq ptt (vlax-curve-getclosestpointto ent pt))
(setq jgb (cons (list ptt str) jgb))
(setq i (1+ i))
)
(setq jgb (vl-sort jgb '(lambda(a b)
(< (vlax-curve-getdistatpoint ent (car a))
(vlax-curve-getdistatpoint ent (car b))
)
)
)
)
(foreach pt jgb
(princ (strcat "\n" (cadr pt)))
)
)
)
)
)
(sssetfirst nil ssb)
(princ)
) |
|