求lisp源码，平行最近直线

fjutcivil · 发表于 2014-4-22 20:46:25

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

如题，如何判断出离文字最近的线，并选择它，eg:一个文字周围有很多直线，我先选择了文字，然后框选周围所有的线，希望能选出最近的线。主要是不懂怎么去实习这个判断的过程。最终的目的是框选所有文字，文字平行到离它最近的直线，直线可能是斜的 ps:积分不够，希望能高手给出纯LISP学习下，蛮多想法会用类似这个判断选择，都卡在这边！！

st788796 · 发表于 2014-4-22 23:32:04

取文字的插入点、角度，对线选集先按角度筛选出和文字平行的，然后以插入点向这些平行线求距离（看高飞的trans文章，或者用vlax-curve-getclosestpointto）,排序找出最近的

fjutcivil · 发表于 2014-4-23 10:05:35

st788796 发表于 2014-4-22 23:32
取文字的插入点、角度，对线选集先按角度筛选出和文字平行的，然后以插入点向这些平行线求距离（看高飞的tr ...

就是你说的后面那一块不懂排序啊那些

st788796 · 发表于 2014-4-23 10:13:25

用距离和线构造表后以距离为索引排序，是不是要排除字两侧线

fjutcivil · 发表于 2014-4-23 10:16:49

st788796 发表于 2014-4-23 10:13
用距离和线构造表后以距离为索引排序，是不是要排除字两侧线

恩，是要选择字下面的线，元老求助啊

st788796 · 发表于 2014-4-23 17:19:16

本帖最后由 st788796 于 2014-4-23 17:22 编辑

fjutcivil 发表于 2014-4-23 10:16
恩，是要选择字下面的线，元老求助啊

(defun c:tt (/ e ss an lst pos e1)
(if (and (setq e (car (xdrx_entsel "\nPick Text: " '((0 . "text")))))
(setq ss (ssget '((0 . "line"))))
)
(progn
(setq an (rem (xdrx_getpropertyvalue e "Rotation") pi)
pos (xdrx_getpropertyvalue e "Position")
lst
(mapcar
'cadr
(vl-remove-if
'(lambda (x)
(not (equal (car x) an 1e-3))
)
(mapcar
'(lambda (a)
(list (rem (xdrx_getpropertyvalue a "Angle") pi)
a
)
)
(xdrx_pickset->ents ss)
)
)
)
)
(setq lst
(mapcar
'(lambda (x / sp mp ep l)
(mapcar 'set '(sp mp ep) (xdrx_curve_getpoint x))
(setq l (trans (mapcar '- pos sp) 0 (mapcar '- ep sp)))
(list (list (car l) (last l))
x
)
)
lst
)
lst (vl-remove-if '(lambda (x) (minusp (caar x))) lst)
lst (vl-sort lst
'(lambda (x1 x2)
(< (caar x1) (caar x2))
)
)
e1 (cadar lst)
)
(xdrx_setpropertyvalue
e
"Position"
(cadr (xdrx_curve_getpoint e1))
)
)
)
(princ)
)

(defun c:tt (/ e ss an lst pos e1) 
  (if (and (setq e (car (xdrx_entsel "\nPick Text: " '((0 . "text"))))) 
           (setq ss (ssget '((0 . "line")))) 
      ) 
    (progn 
      (setq an        (rem (xdrx_getpropertyvalue e "Rotation") pi) 
            pos        (xdrx_getpropertyvalue e "Position") 
            lst 
                (mapcar 
                  'cadr 
                  (vl-remove-if 
                    '(lambda (x) 
                       (not (equal (car x) an 1e-3)) 
                     ) 
                    (mapcar 
                      '(lambda (a) 
                         (list (rem (xdrx_getpropertyvalue a "Angle") pi) 
                               a 
                         ) 
                       ) 
                      (xdrx_pickset->ents ss) 
                    ) 
                  ) 
                ) 
      ) 
      (setq lst 
                (mapcar 
                  '(lambda (x / sp mp ep l) 
                     (mapcar 'set '(sp mp ep) (xdrx_curve_getpoint x)) 
                     (setq l (trans (mapcar '- pos sp) 0 (mapcar '- ep sp))) 
                     (list (list (car l) (last l)) 
                           x 
                     ) 
                   ) 
                  lst 
                ) 
            lst        (vl-remove-if '(lambda (x) (minusp (caar x))) lst) 
            lst        (vl-sort lst 
                         '(lambda (x1 x2) 
                            (< (caar x1) (caar x2)) 
                          ) 
                ) 
            e1        (cadar lst) 
      ) 
      (xdrx_setpropertyvalue 
        e 
        "Position" 
        (cadr (xdrx_curve_getpoint e1)) 
      ) 
    ) 
  ) 
  (princ) 
)

sunykkkk · 发表于 2014-5-14 20:40:40

学习了谢谢

账号		自动登录	找回密码
密码			立即注册

[求助] 求lisp源码，平行最近直线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

点评

浏览过的版块