API应用修剪线头

st788796 · 发表于 2014-4-6 17:17:32

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

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

×

(defun c:tt (/ _trim ss)
(defun _trim (e / s)
(if (setq s (ssget "F" (xdrx_curve_getpoint e) '((0 . "*line,arc"))))
(mapcar
'(lambda (x / p s1)
(and (setq p (xdrx_curve_getinters e x 0))
(= (length p) 1)
(and (not (equal (car p)
(vlax-curve-getstartpoint x)
1e-3
)
)
(not (equal (car p)
(vlax-curve-getendpoint x)
1e-3
)
)
)
(setq s1 (apply 'xdrx_curve_getsplitcurves (cons x p)))
(xdrx_entity_delete
(car (vl-sort (cons x (xdrx_pickset->ents s1) )
'(lambda (e1 e2)
(< (cadr (xdrx_getarea e1))
(cadr (xdrx_getarea e2))
)
)
)
)
)
)
)
(xdrx_pickset->ents s)
)
)
)
(if (setq ss (ssget '((0 . "line"))))
(mapcar '(lambda (x)
(_trim x)
)
(xdrx_pickset->ents ss)
)
)
(princ)
)

(defun c:tt (/ _trim ss) 
  (defun _trim (e / s) 
    (if        (setq s (ssget "F" (xdrx_curve_getpoint e) '((0 . "*line,arc")))) 
      (mapcar 
        '(lambda (x / p s1) 
           (and        (setq p (xdrx_curve_getinters e x 0)) 
                (= (length p) 1) 
                (and (not (equal (car p) 
                                 (vlax-curve-getstartpoint x) 
                                 1e-3 
                          ) 
                     ) 
                     (not (equal (car p) 
                                 (vlax-curve-getendpoint x) 
                                 1e-3 
                          ) 
                     ) 
                ) 
                (setq s1 (apply 'xdrx_curve_getsplitcurves (cons x p))) 
                (xdrx_entity_delete 
                  (car (vl-sort        (cons x (xdrx_pickset->ents s1) ) 
                                '(lambda (e1 e2) 
                                   (< (cadr (xdrx_getarea e1)) 
                                      (cadr (xdrx_getarea e2)) 
                                   ) 
                                 ) 
                       ) 
                  ) 
                ) 
           ) 
         ) 
        (xdrx_pickset->ents s) 
      ) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "line")))) 
    (mapcar '(lambda (x) 
               (_trim x) 
             ) 
            (xdrx_pickset->ents ss) 
    ) 
  ) 
  (princ) 
)

Lisphk · 发表于 2014-4-6 18:41:57

大师，判断的依据是什么？是短的部分裁剪掉吗？如果直线两侧都有长短的，怎么裁？

st788796 · 发表于 2014-4-6 19:08:19

第一个短的，相等时听天由命

守仁格竹GM · 发表于 2014-4-8 08:02:41

:lol

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

[教学] API应用 修剪线头

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

[教学] API应用修剪线头