- (defun GetPts (Lst)
- (if (caddr Lst)
- (cons
- (list (car Lst) (cadr Lst) (caddr Lst))
- (GetPts (cdddr Lst))
- )
- )
- )
- (defun intersectPts (vlaobj1 vlaobj2 / ptsVar ptsArray ptsList)
- (setq ptsVar (vla-intersectwith vlaobj1 vlaobj2 acExtendNone)
- ptsArray (vlax-variant-value ptsVar)
- ptsList (vl-catch-all-apply 'vlax-safeArray->list (list ptsArray))
- )
- (if (vl-catch-all-error-p ptsList)
- nil
- (GetPts ptsList)
- )
- )
- (defun RemoveParam (EndPrm Pline / SomPrm)
- (cond ((= EndPrm 0) nil)
- ((= (setq SomPrm (vlax-curve-GetParamAtPoint
- Pline
- (vlax-curve-GetPointAtParam Pline EndPrm)
- )
- )
- EndPrm
- )
- (RemoveParam (1- EndPrm) Pline)
- )
- ((/= SomPrm EndPrm)
- (cons SomPrm (RemoveParam (1- EndPrm) Pline))
- )
- )
- )
- (defun GetAllSelfInters (Ename / VlaObj PrmLst)
- (setq VlaObj (vlax-ename->vla-object Ename))
- (setq
- PrmLst (append
- (vl-remove-if
- (function (lambda (x) (= (fix x) x)))
- (mapcar
- (function
- (lambda (x) (vlax-curve-GetParamAtPoint VlaObj x))
- )
- (intersectPts VlaObj VlaObj)
- )
- )
- (RemoveParam (vlax-curve-GetEndParam VlaObj) VlaObj)
- )
- )
- (mapcar (function (lambda (x) (vlax-curve-GetPointAtParam VlaObj x))
- )
- (vl-sort PrmLst '<)
- )
- )
|