XDGE几何库应用(21)--Lisp函数

st788796 · 发表于 2014-9-30 14:06:32

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

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

×

本帖最后由 st788796 于 2014-11-1 07:54 编辑

几何库很强大，但 Lisp 中使用绕来绕去的也麻烦，集中起来写写Lisp库就方便些

(defun XDGL::Curve:GetParamAtPoint (ge pt)
(xdge::getpropertyvalue
ge
"paramOf"
(xdge::getpropertyvalue ge "closestPointTo" pt)
)
)

st788796 · 发表于 2014-10-1 07:40:56

本帖最后由 st788796 于 2014-10-1 09:05 编辑

(defun XDGL::Curve:GetFirstDeriv (ge pnt / lst)
(if (and (setq lst (xdge::getpropertyvalue
ge
"evalPoint"
(XDGL::Curve:GetParamAtPoint ge pnt)
2
)
)
(= (length lst) 2)
(eq (type (cadr lst)) 'LIST)
)
(xdrx_vector_normalize (caadr lst))
)
)

;;Ge 曲线 EndParam

(defun XDGL::Curve:GetEndParam (ge / ep)
(if (setq ep (xdge::getpropertyvalue ge "hasEndPoint"))
(xdge::getpropertyvalue ge "paramOf" ep)
)
)

;;Ge 曲线模拟点
;;等分点用 (xdge::getpropertyvalue ge "getSamplePoints" from to int)

(defun XDGL::Curve:GetSamplePoints (ge from to chord-height / params)
(if (xdge::getpropertyvalue ge "isLinear")
(mapcar 'list (xdge::getpropertyvalue ge "hasStartPoint" "hasEndPoint")
'(0.0 1.0)
)
(if (and (> chord-height 0.0)
(setq epam (XDGL::Curve:GetEndParam ge))
(<= 0.0 from epam)
(<= to epam)
(< from to)
)
(progn
(setq params (xdge::getpropertyvalue
ge "getSamplePoints" from to chord-height)
)
(list (mapcar '(lambda (x)
(list (xdge::getpropertyvalue ge "evalPoint" x) x)
)
params
)
params
)
)
)
)
)

st788796 · 发表于 2014-10-1 11:31:16

本帖最后由 st788796 于 2014-10-1 11:37 编辑

用 Ge 获取整条线的定距分割点或定数等分点
cv ---- AcGeCurve 或 AcDbCurve
n ---- 实数是为定距分割，整数时为定数等分

(defun XDGL::Curve:NumDiv (cv n / ge pts len nn in)
(setq ge (xdge::constructor cv))
(if (= (type n) 'REAL)
(progn
(setq len (xdge::getpropertyvalue ge "length")
nn (fix (/ len n))
in (xdge::constructor "AcGeInterval" 0.0 (* nn n))
)
(xdge::setpropertyvalue ge "setInterval" in)
(setq n nn)
)
)
(setq pts (xdge::getpropertyvalue ge "getSamplePoints" (fix n)))
(xdge::free ge)
pts
)

st788796 · 发表于 2014-10-1 12:09:59

st788796 发表于 2014-10-1 11:31
用 Ge 获取整条线的定距分割点或定数等分点
cv ---- AcGeCurve 或 AcDbCurve
n ---- 实数是为定距分割， ...

再改进一次 Cv 可以为 DbCurve GeCurve Points

(defun XDGL::Curve:NumDiv (cv n / ge pts len nn in)
(if (eq (type cv) 'LIST)
(setq ge (xdge::constructor
"kCompositeCrv3d"
(mapcar '(lambda (x y)
(xdge::constructor "kLineSeg3d" x y)
)
cv
(cdr cv)
)
)
)
(setq ge (xdge::constructor cv))
)
(if (= (type n) 'REAL)
(progn
(setq len (xdge::getpropertyvalue ge "length")
nn (fix (/ len n))
in (xdge::constructor "AcGeInterval" 0.0 (* nn n))
)
(xdge::setpropertyvalue ge "setInterval" in)
(setq n nn)
)
)
(setq pts (xdge::getpropertyvalue ge "getSamplePoints" (fix n)))
(xdge::free ge)
pts
)

st788796 · 发表于 2014-10-4 19:17:14

(defun XDGL::Curve:GetSubCurve
(ge from to / prec in atStart atEnd clone nin)
(setq prec (car (xdrx_document_getprec))
in (car (xdge::getpropertyvalue ge "getInterval"))
atStart (equal (xdge::getpropertyvalue in "lowerBound")
to
prec
)
atEnd (equal (xdge::getpropertyvalue in "upperBound")
from
prec
)
)
(cond
((and atStart atEnd) ge)
((= (xdge::type ge) "kNurbCurve3d")
(setq clone (xdge::copy ge))
(if (< from to)
(if (or atStart atEnd)
(progn
(xdge::setpropertyvalue clone "hardTrimByParams" from to)
clone
)
(progn
(xdge::setpropertyvalue
clone
"hardTrimByParams"
(xdge::getpropertyvalue in "lowerBound")
to
)
(xdge::setpropertyvalue clone "hardTrimByParams" from to)
clone
)
)
(progn
(setq clone1 (xdge::copy ge)
clone2 (xdge::copy ge)
)
(xdge::setpropertyvalue
clone1
"hardTrimByParams"
from
(xdge::getpropertyvalue in "upperBound")
)
(xdge::setpropertyvalue
clone2
"hardTrimByParams"
(xdge::getpropertyvalue in "lowerBound")
to
)
(xdge::setpropertyvalue clone1 "joinWith" clone2)
clone1
)
)
)
(t
(setq clone (xdge::copy ge)
nin (xdge::constructor "AcGeInterval" from to)
)
(xdge::setpropertyvalue clone "setInterval" nin)
clone
)
)
)

(defun XDGL::Curve:GetSubCurve 
       (ge from to / prec in atStart atEnd clone nin) 
  (setq        prec        (car (xdrx_document_getprec)) 
        in        (car (xdge::getpropertyvalue ge "getInterval")) 
        atStart        (equal (xdge::getpropertyvalue in "lowerBound") 
                       to 
                       prec 
                ) 
        atEnd        (equal (xdge::getpropertyvalue in "upperBound") 
                       from 
                       prec 
                ) 
  ) 
  (cond 
    ((and atStart atEnd) ge) 
    ((= (xdge::type ge) "kNurbCurve3d") 
     (setq clone (xdge::copy ge)) 
     (if (< from to) 
       (if (or atStart atEnd) 
         (progn 
           (xdge::setpropertyvalue clone "hardTrimByParams" from to) 
           clone 
         ) 
         (progn 
           (xdge::setpropertyvalue 
             clone 
             "hardTrimByParams" 
             (xdge::getpropertyvalue in "lowerBound") 
             to 
           ) 
           (xdge::setpropertyvalue clone "hardTrimByParams" from to) 
           clone 
         ) 
       ) 
       (progn 
         (setq clone1 (xdge::copy ge) 
               clone2 (xdge::copy ge) 
         ) 
         (xdge::setpropertyvalue 
           clone1 
           "hardTrimByParams" 
           from 
           (xdge::getpropertyvalue in "upperBound") 
         ) 
         (xdge::setpropertyvalue 
           clone2 
           "hardTrimByParams" 
           (xdge::getpropertyvalue in "lowerBound") 
           to 
         ) 
         (xdge::setpropertyvalue clone1 "joinWith" clone2) 
         clone1 
       ) 
     ) 
    ) 
    (t 
     (setq clone (xdge::copy ge) 
           nin         (xdge::constructor "AcGeInterval" from to) 
     ) 
     (xdge::setpropertyvalue clone "setInterval" nin) 
     clone 
    ) 
  ) 
)

st788796 · 发表于 2014-10-15 09:06:56

继续，AcGeCompositeCrv3d 的 GetSplitCurves ，改编自 lzh 的 Net 版函数，尚未测试

(defun XDGL::Curve:GetSplitCurves (c3d pars / prec
inter c3ds lowerBound
upperBound tf in1
in2 j cp1 cp2
seg1 seg2 cs1 cs
curves
)
(defun _remvoedups (lst / nlst)
(setq lst (vl-sort lst '>)
nlst (list (car lst))
lst (cdr lst)
)
(while lst
(if (not (equal (car lst) (car nlst) prec))
(setq nlst (cons (car lst) nlst))
)
(setq lst (cdr lst))
)
nlst
)
(setq prec (car (xdrx_document_getprec))
inter (car (xdge::getpropertyvalue c3d "getIntervarl"))
c3ds (xdge::getpropertyvalue c3d "getCurveList")
pars (_remvoedups lst)
tf t
)
(mapcar 'set
'(lowerBound upperBound)
(xdge::getpropertyvalue inter "lowerBound" "upperBound")
)
(if (= (length pars) 0)
(setq tf nil)
(progn
(if (and (= (length c3ds) 1)
(xdge::getpropertyvalue (car c3ds) "isClosed")
)
(if (> (length pars) 1)
(progn
(if (equal (car pars) lowerBound prec)
(progn
(setq pars (cons lowerBound (cdr pars)))
(if (equal (last pars) upperBound prec)
(progn
(setq pars (reverse (cdr (reverse pars))))
(if (= (length pars) 1)
(setq tf nil)
)
)
)
)
(if (equal (last pars) upperBound prec)
(setq pars
(reverse (cons upperBound (cdr (reverse pars))))
)
)
)
(setq pars (reverse (cons upperBound (cdr pars))))
)
(setq tf nil)
)
(progn
(if (equal (car pars) lowerBound prec)
(setq pars (cons lowerBound (cdr pars)))
(setq pars (cons lowerBound pars))
)
(if (equal (last pars) upperBound prec)
(setq pars (reverse (cons upperBound (cdr (reverse pars)))))
(setq pars (reverse (cons upperBound (reverse pars))))
)
)
)
)
)
(if tf
(progn
(setq i 0)
(repeat (length pars)
(mapcar 'set
'(cp1 seg1)
(xdge::getpropertyvalue c3d "globalToLocalParameter")
)
(mapcar 'set
'(cp2 seg2)
(xdge::getpropertyvalue c3d "globalToLocalParameter")
)
(if (= seg1 seg2)
(setq cc3ds
(cons (xdgl::curve:getsubcurve (nth seg1 c3ds) cp1 cp2)
)
)
(progn
(setq in1 (car (xdge::getpropertyvalue
(nth seg1 c3ds)
"getInterval"
)
)
)
(setq
cc3ds (cons (xdgl::curve:getsubcurve
(nth seg1 c3ds)
cp1
(xdge::getpropertyvalue in1 "upperBound")
)
)
)
(setq j (1+ seg1))
(while (< j seg2)
(setq cc3ds (cons (xdge::copy (nth j c3ds)) cc3ds)
(setq j (1+ j))
)
)
(setq in2 (car (xdge::getpropertyvalue
(nth seg2 c3ds)
"getInterval"
)
)
)
(setq cc3ds
(cons (xdgl::curve:getsubcurve
(nth seg2 c3ds)
(xdge::getpropertyvalue in2 "lowerBound")
cp2
)
)
)
)
)
(setq curves (cons (xdge::constructro
"kCompositeCrv3d"
(reverse cc3ds)
)
curves
)
)
)
)
)
(if (and
(xdge::getpropertyvalue c3d "isClosed")
(> (xdge::getpropertyvalue c3ds "length") 1)
)
(progn
(setq curves (reverse curves)
cs (xdge::getpropertyvalue (last curves) "getCurveList")
cs1 (xdge::getpropertyvalue (car curves) "getCurveList")
cs (append cs cs1)
curves (reverse (cons (xdge::constructro "kCompositeCrv3d" cs)
(cdr (reverse curves))
)
)
curves (cdr curves)
)
)
)
curves
)

(defun XDGL::Curve:GetSplitCurves (c3d           pars           /           prec 
                                   inter   c3ds           lowerBound 
                                   upperBound           tf           in1 
                                   in2           j           cp1           cp2 
                                   seg1           seg2           cs1           cs 
                                   curves 
                                  ) 
  (defun _remvoedups (lst / nlst) 
    (setq lst  (vl-sort lst '>) 
          nlst (list (car lst)) 
          lst  (cdr lst) 
    ) 
    (while lst 
      (if (not (equal (car lst) (car nlst) prec)) 
        (setq nlst (cons (car lst) nlst)) 
      ) 
      (setq lst (cdr lst)) 
    ) 
    nlst 
  ) 
  (setq        prec  (car (xdrx_document_getprec)) 
        inter (car (xdge::getpropertyvalue c3d "getIntervarl")) 
        c3ds  (xdge::getpropertyvalue c3d "getCurveList") 
        pars  (_remvoedups lst) 
        tf    t 
  ) 
  (mapcar 'set 
          '(lowerBound upperBound) 
          (xdge::getpropertyvalue inter "lowerBound" "upperBound") 
  ) 
  (if (= (length pars) 0) 
    (setq tf nil) 
    (progn 
      (if (and (= (length c3ds) 1) 
               (xdge::getpropertyvalue (car c3ds) "isClosed") 
          ) 
        (if (> (length pars) 1) 
          (progn 
            (if        (equal (car pars) lowerBound prec) 
              (progn 
                (setq pars (cons lowerBound (cdr pars))) 
                (if (equal (last pars) upperBound prec) 
                  (progn 
                    (setq pars (reverse (cdr (reverse pars)))) 
                    (if        (= (length pars) 1) 
                      (setq tf nil) 
                    ) 
                  ) 
                ) 
              ) 
              (if (equal (last pars) upperBound prec) 
                (setq pars 
                       (reverse (cons upperBound (cdr (reverse pars)))) 
                ) 
              ) 
            ) 
            (setq pars (reverse (cons upperBound (cdr pars)))) 
          ) 
          (setq tf nil) 
        ) 
        (progn 
          (if (equal (car pars) lowerBound prec) 
            (setq pars (cons lowerBound (cdr pars))) 
            (setq pars (cons lowerBound pars)) 
          ) 
          (if (equal (last pars) upperBound prec) 
            (setq pars (reverse (cons upperBound (cdr (reverse pars))))) 
            (setq pars (reverse (cons upperBound (reverse pars)))) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (if tf 
    (progn 
      (setq i 0) 
      (repeat (length pars) 
        (mapcar        'set 
                '(cp1 seg1) 
                (xdge::getpropertyvalue c3d "globalToLocalParameter") 
        ) 
        (mapcar        'set 
                '(cp2 seg2) 
                (xdge::getpropertyvalue c3d "globalToLocalParameter") 
        ) 
        (if (= seg1 seg2) 
          (setq        cc3ds 
                 (cons (xdgl::curve:getsubcurve (nth seg1 c3ds) cp1 cp2) 
                 ) 
          ) 
          (progn 
            (setq in1 (car (xdge::getpropertyvalue 
                             (nth seg1 c3ds) 
                             "getInterval" 
                           ) 
                      ) 
            ) 
            (setq 
              cc3ds (cons (xdgl::curve:getsubcurve 
                            (nth seg1 c3ds) 
                            cp1 
                            (xdge::getpropertyvalue in1 "upperBound") 
                          ) 
                    ) 
            ) 
            (setq j (1+ seg1)) 
            (while (< j seg2) 
              (setq cc3ds (cons (xdge::copy (nth j c3ds)) cc3ds) 
                    (setq j (1+ j)) 
              ) 
            ) 
            (setq in2 (car (xdge::getpropertyvalue 
                             (nth seg2 c3ds) 
                             "getInterval" 
                           ) 
                      ) 
            ) 
            (setq cc3ds 
                   (cons (xdgl::curve:getsubcurve 
                           (nth seg2 c3ds) 
                           (xdge::getpropertyvalue in2 "lowerBound") 
                           cp2 
                         ) 
                   ) 
            ) 
          ) 
        ) 
        (setq curves (cons (xdge::constructro 
                             "kCompositeCrv3d" 
                             (reverse cc3ds) 
                           ) 
                           curves 
                     ) 
        ) 
      ) 
    ) 
  ) 
  (if (and 
        (xdge::getpropertyvalue c3d "isClosed") 
        (> (xdge::getpropertyvalue c3ds "length") 1) 
      ) 
    (progn 
      (setq curves (reverse curves) 
            cs           (xdge::getpropertyvalue (last curves) "getCurveList") 
            cs1           (xdge::getpropertyvalue (car curves) "getCurveList") 
            cs           (append cs cs1) 
            curves (reverse (cons (xdge::constructro "kCompositeCrv3d" cs) 
                                  (cdr (reverse curves)) 
                            ) 
                   ) 
            curves (cdr curves) 
      ) 
    ) 
  ) 
  curves 
)

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

[教学] XDGE几何库应用(21)--Lisp函数

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

本帖被以下淘专辑推荐: