选择线附近文字

shanjiwang

目前有一串代码，选择线附近文字，有几个缺点，麻烦论坛改善，谢谢！缺点：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)
)

xdcad9819

论坛上有个帖子

WongFoling

解决了吗?正需要这个功能