API应用封闭曲线内外修剪

st788796 · 发表于 2014-2-17 17:14:42

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

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

×

(defun c:tt (/ _isout e key ss1 pts ptl)
(defun _isout (e1 e / sp ep mp stf etf mtf)
(mapcar 'set '(sp mp ep) (xdrx_curve_getpoint e1))
(setq stf (equal sp (xdrx_curve_getclosestpoint e sp) 1e-3)
etf (equal ep (xdrx_curve_getclosestpoint e ep) 1e-3)
mtf (xdrx_point_isinside mp e)
)
(or (or (not stf)
(not etf)
)
(and (and stf etf (not mtf)))
)
)
(if (and (setq e (car (xdrx_entsel
"\n选择封闭线: "
'((0 . "*LINE,CIRCE,ELLIPSE"))
)
)
)
(xdrx_curve_isclosed e)
(setq pts (xdrx_getsamplept e))
(setq ss (ssget "F" pts '((0 . "*line,circle,arc,ellipse"))))
(setq key (xdrx_yesorno "内部修剪<N修剪外部>" "Y"))
)
(progn
(xdrx_setmark)
(ssdel e ss)
(mapcar '(lambda (x / ptl pams)
(setq ptl (xdrx_curve_getinters x e 0)
pams (mapcar '(lambda (a)
(xdrx_curve_getparamatpoint x a)
)
ptl
)
pams (vl-sort pams '<)
)
(apply 'xdrx_curve_getsplitcurves (cons x pams))
)
(xdrx_pickset->ents ss)
)
(setq ss1 (xdrx_pickset_union ss (xdrx_getss)))
(if (zerop key)
(mapcar '(lambda (x)
(if (_isout x e) (xdrx_entity_delete x))
)
(xdrx_pickset->ents ss1)
)
(mapcar '(lambda (x)
(if (not (_isout x e)) (xdrx_entity_delete x))
)
(xdrx_pickset->ents ss1)
)
)
)
)
(princ)
)

(defun c:tt (/ _isout e key ss1 pts ptl) 
  (defun _isout (e1 e / sp ep mp stf etf mtf) 
    (mapcar 'set '(sp mp ep) (xdrx_curve_getpoint e1)) 
    (setq stf (equal sp (xdrx_curve_getclosestpoint e sp) 1e-3) 
          etf (equal ep (xdrx_curve_getclosestpoint e ep) 1e-3) 
          mtf (xdrx_point_isinside mp e) 
    ) 
    (or        (or (not stf) 
            (not etf) 
        ) 
        (and (and stf etf (not mtf))) 
    ) 
  )              
  (if (and (setq e (car        (xdrx_entsel 
                          "\n选择封闭线: " 
                          '((0 . "*LINE,CIRCE,ELLIPSE")) 
                        ) 
                   ) 
           ) 
           (xdrx_curve_isclosed e) 
           (setq pts (xdrx_getsamplept e)) 
           (setq ss (ssget "F" pts '((0 . "*line,circle,arc,ellipse")))) 
           (setq key (xdrx_yesorno "内部修剪<N修剪外部>" "Y")) 
      ) 
    (progn 
      (xdrx_setmark) 
      (ssdel e ss) 
      (mapcar '(lambda (x / ptl pams) 
                 (setq ptl  (xdrx_curve_getinters x e 0) 
                       pams (mapcar '(lambda (a) 
                                       (xdrx_curve_getparamatpoint x a) 
                                     ) 
                                    ptl 
                            ) 
                       pams (vl-sort pams '<)                                      
                 ) 
                 (apply 'xdrx_curve_getsplitcurves (cons x pams)) 
               ) 
              (xdrx_pickset->ents ss) 
      ) 
      (setq ss1 (xdrx_pickset_union ss (xdrx_getss))) 
      (if (zerop key) 
        (mapcar        '(lambda (x) 
                   (if (_isout x e) (xdrx_entity_delete x)) 
                 ) 
                (xdrx_pickset->ents ss1) 
        ) 
        (mapcar        '(lambda (x) 
                   (if (not (_isout x e)) (xdrx_entity_delete x)) 
                 ) 
                (xdrx_pickset->ents ss1) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

kwok · 发表于 2014-2-17 20:07:55

支持一下.学习学习.

ShaoRui · 发表于 2017-10-5 16:54:09

支持一下.学习学习.

xiaoyaoge00 · 发表于 2018-4-25 18:08:48

支持，学习了，现在使用看看

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

[教学] API应用 封闭曲线内外修剪

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

[教学] API应用封闭曲线内外修剪