很多时候会遇到不能 Offset 的 Spline
贴上我写的部分,优化部分省略:)

- (defun c:s2p (/ doc ms)
- (setq doc (vla-get-activedocument (vlax-get-acad-object))
- ms (vla-get-modelspace doc)
- )
- (vla-startundomark doc)
- (vl-catch-all-apply
- '(lambda (/ ss ssl i e el p10 sepm tf pl epm n m len pt pts)
- (if (setq ss (ssget '((0 . "spline"))))
- (progn
- (setq ssl (sslength ss)
- i -1
- )
- (repeat ssl
- (princ (strcat "\r共 "
- (itoa ssl)
- " 个 Spline, 处理第 "
- (itoa (1+ i))
- " 个Spline....."
- )
- )
- (setq e (ssname ss (setq i (1+ i)))
- el (entget e)
- p10 (vl-remove-if-not
- '(lambda (x) (= (car x) 10))
- el
- )
- sepm (vlax-curve-getendparam e)
- tf (vlax-curve-isclosed e)
- )
- (if (assoc 11 el) ;_ has fitpoints
- (progn
- (setq p10 (apply 'append (mapcar 'cdr p10))
- pl (vla-addpolyline
- ms
- (vlax-make-variant
- (vlax-safearray-fill
- (vlax-make-safearray
- vlax-vbdouble
- (cons 0 (1- (length p10)))
- )
- p10
- )
- )
- )
- )
- (vla-put-type pl acCubicSplinePoly)
- ;;样条化的线仍需要后续处理 ....
- )
- (progn
- (entmake
- (append
- '((0 . "LWPOLYLINE")
- (100 . "AcDbEntity")
- (100 . "AcDbPolyline")
- )
- (list (cons 90 (cdr (assoc 73 el))))
- (if tf
- '((70 . 1))
- '((70 . 0))
- )
- (mapcar '(lambda (x) (reverse (cdr (reverse x))))
- p10
- )
- )
- )
- )
- )
- )
- (vl-cmdf ".erase" ss "")
- )
- )
- )
- )
- (vla-endundomark doc)
- (princ)
- )
- (princ "\n\tStart Command with S2P, eachy[eachy@21cn.com]!")
- (princ)
|