[LISP函数]：SPLINE转PLINE的小程序

eachy · 发表于 2006-9-1 14:26:21

很多时候会遇到不能 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)

(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)

taner · 发表于 2008-12-19 08:31:22

安装DXB打印机，打印，生成dxb文件。然后dxbin。

and2008 · 发表于 2008-12-19 11:36:42

很想看4楼的，可是连接失效了，：（

lcl19811125 · 发表于 2009-12-31 12:24:50

高手啊！！我就是不会，呵呵

ljttjl · 发表于 2010-1-1 19:25:57

http://ljttjl.ys168.com 20080420目录下载任意曲线转换成多段线程序

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