用一系列点断开曲线

eachy · 发表于 2014-2-28 18:47:55

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

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

×

把 ssbrk 拆分成函数，

(defun _IsEndPoints (ptl pts)
(or (equal ptl pts 1e-5)
(equal ptl (reverse pts) 1e-5)
)
)
(defun Pnts:SortOnCurve (e pts / ptl)
(if (= (length pts) 1)
pts
(progn
(setq pts (vl-sort pts
'(lambda (e1 e2)
(> (vlax-curve-getdistatpoint
e
(vlax-curve-getclosestpointto e e1)
)
(vlax-curve-getdistatpoint
e
(vlax-curve-getclosestpointto e e2)
)
)
)
)
ptl (cons (car pts) ptl)
)
(while (setq pts (cdr pts))
(if (equal (car pts) (car ptl) fuzz)
nil
(setq ptl (cons (car pts) ptl))
)
)
ptl
)
)
)
(defun Line:GetSplitCurves (e pts / sp ep el elst)
(setq sp (vlax-curve-getstartpoint e)
ep (vlax-curve-getendpoint e)
)
(if (not (_isendpoints (list sp ep) pts))
(progn
(setq el (entget e '("*"))
pts (Pnts:SortOnCurve e (cons ep (cons sp pts)))
)
(setq el (subst (cons 11 (cadr pts))
(assoc 11 el)
el
)
)
(entmod el)
(setq elst (mapcar '(lambda (p1 p2)
(setq el (subst (cons 10 p1)
(assoc 10 el)
el
)
el (subst (cons 11 p2)
(assoc 11 el)
el
)
)
(entmake el)
)
(cdr pts)
(cddr pts)
)
)
(cons e elst)
)
)
)
(defun Arc:GetSplitCurves (e pts / sp ep el tf elst)
(setq sp (vlax-curve-getstartpoint e)
ep (vlax-curve-getendpoint e)
)
(if (not (_isendpoints (list sp ep) pts))
(progn
(setq el (entget e '("*"))
spam (vlax-curve-getstartparam e)
pts (Pnts:SortOnCurve e (cons ep (cons sp pts)))
tf (< (cdr (assoc 51 el)) (+ pi pi))
)
(if tf
(setq pts (mapcar '(lambda (x)
(vlax-curve-getparamatpoint e x)
)
pts
)
)
(setq
pts (mapcar '(lambda (x / pam)
(setq pam (vlax-curve-getparamatpoint e x))
(if (< pam spam)
(+ pam pI pi)
pam
)
)
pts
)
)
)
(setq el (subst (cons 51 (cadr pts))
(assoc 51 el)
el
)
)
(entmod el)
(setq elst mapcar
'(lambda (p1 p2 /)
(setq el (subst (cons 50 p1)
(assoc 50 el)
el
)
el (subst (cons 51 p2)
(assoc 51 el)
el
)
)
(entmake el)
)
(cdr pts)
(cddr pts)
)
(cons e elst)
)
)
)

(defun _IsEndPoints (ptl pts) 
    (or        (equal ptl pts 1e-5) 
        (equal ptl (reverse pts) 1e-5) 
    ) 
  ) 
  (defun Pnts:SortOnCurve (e pts / ptl) 
    (if        (= (length pts) 1) 
      pts 
      (progn 
        (setq pts (vl-sort pts 
                           '(lambda (e1 e2) 
                              (> (vlax-curve-getdistatpoint 
                                   e 
                                   (vlax-curve-getclosestpointto e e1) 
                                 ) 
                                 (vlax-curve-getdistatpoint 
                                   e 
                                   (vlax-curve-getclosestpointto e e2) 
                                 ) 
                              ) 
                            ) 
                  ) 
              ptl (cons (car pts) ptl) 
        ) 
        (while (setq pts (cdr pts)) 
          (if (equal (car pts) (car ptl) fuzz) 
            nil 
            (setq ptl (cons (car pts) ptl)) 
          ) 
        ) 
        ptl 
      ) 
    ) 
  ) 
  (defun Line:GetSplitCurves (e pts / sp ep el elst) 
    (setq sp (vlax-curve-getstartpoint e) 
          ep (vlax-curve-getendpoint e) 
    ) 
    (if        (not (_isendpoints (list sp ep) pts)) 
      (progn 
        (setq el  (entget e '("*")) 
              pts (Pnts:SortOnCurve e (cons ep (cons sp pts))) 
        ) 
        (setq el (subst        (cons 11 (cadr pts)) 
                        (assoc 11 el) 
                        el 
                 ) 
        ) 
        (entmod el) 
        (setq elst (mapcar '(lambda (p1 p2) 
                              (setq el (subst (cons 10 p1) 
                                              (assoc 10 el) 
                                              el 
                                       ) 
                                    el (subst (cons 11 p2) 
                                              (assoc 11 el) 
                                              el 
                                       ) 
                              ) 
                              (entmake el) 
                            ) 
                           (cdr pts) 
                           (cddr pts) 
                   ) 
        ) 
        (cons e elst) 
      ) 
    ) 
  ) 
  (defun Arc:GetSplitCurves (e pts / sp ep el tf elst) 
    (setq sp (vlax-curve-getstartpoint e) 
          ep (vlax-curve-getendpoint e) 
    ) 
    (if        (not (_isendpoints (list sp ep) pts)) 
      (progn 
        (setq el   (entget e '("*")) 
              spam (vlax-curve-getstartparam e) 
              pts  (Pnts:SortOnCurve e (cons ep (cons sp pts))) 
              tf   (< (cdr (assoc 51 el)) (+ pi pi)) 
        ) 
        (if tf 
          (setq        pts (mapcar '(lambda (x) 
                               (vlax-curve-getparamatpoint e x) 
                             ) 
                            pts 
                    ) 
          ) 
          (setq 
            pts        (mapcar        '(lambda (x / pam) 
                           (setq pam (vlax-curve-getparamatpoint e x)) 
                           (if (< pam spam) 
                             (+ pam pI pi) 
                             pam 
                           ) 
                         ) 
                        pts 
                ) 
          ) 
        ) 
        (setq el (subst        (cons 51 (cadr pts)) 
                        (assoc 51 el) 
                        el 
                 ) 
        ) 
        (entmod el) 
        (setq elst mapcar 
              '(lambda (p1 p2 /) 
                 (setq el (subst (cons 50 p1) 
                                 (assoc 50 el) 
                                 el 
                          ) 
                       el (subst (cons 51 p2) 
                                 (assoc 51 el) 
                                 el 
                          ) 
                 ) 
                 (entmake el) 
               ) 
               (cdr pts) 
              (cddr pts) 
        ) 
        (cons e elst) 
      ) 
    ) 
  )

待续......

ysq101 · 发表于 2014-2-28 19:59:28

版主。。。什么时候可以修复1208的LISP通用函数啊（PS：开自带VLISP编辑器CAD会挂）？？
好期待啊~~~~

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

[原创] 用一系列点断开曲线

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