求助。三维或者二维多段线。。。转多段线。。。

egoroom

(defun C:t2()
        (VL-LOAD-COM)
  
        (setq AcadObject (vlax-get-acad-object))
        (setq AcadDocument (vla-get-ActiveDocument Acadobject))
        (setq mSpace (vla-get-ModelSpace Acaddocument))


        (setq ss1 (ssget '((0 . "POLYLINE"))))
        (setq n (sslength ss1))
        (setq m 0)

        (while (< m n)
        (setq ename (ssname ss1 m))

        (setq ent_data (entget ename))
        (setq str_0 (cdr (assoc 0 ent_data)))
        (while (/= str_0 "POLYLINE")
        (setq ename (car (entsel "选择的实体非三维多段线,请重新选择!:")))
        (setq ent_data (entget ename))
        (setq str_0 (cdr (assoc 0 ent_data)))
        )
        (setq obj (vlax-ename->vla-object ename))
        (setq pts (vlax-variant-value (vla-get-coordinates obj)))
        (vla-AddPolyline mSpace pts)

        (setq m (+ 1 m))
);while
        (command "_erase" ss1 "")
        (princ)     

egoroom

楼上VBALISPER兄弟的函数。。在此感谢。。
目前可以实现三维多段线转二维多段线。。。。希望可以实现三维包括二维多段线转普通多段线。。。谢谢了。。。

Andyhon

分段的话 接下来就交给 CONVERTPOLY 指令接手  ===> LwPolyLine

xyp1964

2. 
   
3. ;; 伪源码，需要e派工具箱(XCAD)的支持：http://xyp1964.ys168.com
   
4. (defun c:t2 ()
   
5.   (if (setq ss (ssget '((0 . "*POLYLINE"))))
   
6.     (progn
   
7.       (setq i -1)
   
8.       (while (setq s1 (ssname ss (setq i (1+ i))))
   
9.         (setq ptn (xyp-get-Vertexs s1 0)
   
10.               ptn (mapcar 'xyp-3d2d ptn)
    
11.         )
    
12.         (if (xyp-Curve-Close s1)
    
13.           (xyp-Entmake-lwPolyline ptn t)
    
14.           (xyp-Entmake-lwPolyline ptn nil)
    
15.         )
    
16.       )
    
17.       (xyp-erase ss)
    
18.     )
    
19.   )
    
20.   (princ)
    
21. )

<br /> ;; 伪源码，需要e派工具箱(XCAD)的支持：http://xyp1964.ys168.com<br /> (defun c:t2 ()<br />   (if (setq ss (ssget '((0 . "*POLYLINE"))))<br />     (progn<br />       (setq i -1)<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq ptn (xyp-get-Vertexs s1 0)<br />               ptn (mapcar 'xyp-3d2d ptn)<br />         )<br />         (if (xyp-Curve-Close s1)<br />           (xyp-Entmake-lwPolyline ptn t)<br />           (xyp-Entmake-lwPolyline ptn nil)<br />         )<br />       )<br />       (xyp-erase ss)<br />     )<br />   )<br />   (princ)<br /> )

chpmould

刚好以前写了一个这样的函数，看你用的上不

2. ;;测试例子:
   
3. (defun c:t2 ()
   
4.   (if (setq ss (ssget '((0 . "*POLYLINE"))))
   
5.     (progn
   
6.       (setq i -1)
   
7.       (while (setq s1 (ssname ss (setq i (1+ i))))
   
8.         (setq lst (Get_PointList s1))
   
9.         (entmake (append (list '(0 . "LWPOLYLINE")
   
10.              '(62 . 6)
    
11.              '(100 . "AcDbEntity")
    
12.              '(100 . "AcDbPolyline")
    
13.              (cons 90 (length lst)))
    
14.         (mapcar '(lambda (pt) (cons 10 pt)) lst))))
    
15.     (vl-cmdf "_erase" ss "")))
    
16.   (princ)
    
17. )  

;;测试例子:<br /> (defun c:t2 ()<br />   (if (setq ss (ssget '((0 . "*POLYLINE"))))<br />     (progn<br />       (setq i -1)<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq lst (Get_PointList s1))<br />         (entmake (append (list '(0 . "LWPOLYLINE")<br />              '(62 . 6)<br />              '(100 . "AcDbEntity")<br />              '(100 . "AcDbPolyline")<br />              (cons 90 (length lst)))<br />         (mapcar '(lambda (pt) (cons 10 pt)) lst))))<br />     (vl-cmdf "_erase" ss "")))<br />   (princ)<br /> )  

egoroom

chpmould 发表于 2012-7-5 22:12
刚好以前写了一个这样的函数，看你用的上不

你好。。又能在2007上用的吗？可以直接转为多段线吗。。。麻烦了。。谢谢

egoroom

麻烦你帮测下。。。我的场景

egoroom

chpmould 发表于 2012-7-5 22:12
刚好以前写了一个这样的函数，看你用的上不

麻烦你帮测下。。。我的场景

egoroom

egoroom 发表于 2012-7-5 22:26
你好。。又能在2007上用的吗？可以直接转为多段线吗。。。麻烦了。。谢谢

执行后反馈no function definition: GET_POINTLIST。。不知道什么意思。我的cad版本2007

VBALISPER

我在在他原来提供的一段代码上改的.虽然由3D多段变成了2维多段.但是属性看不到.不能再用CONVERTPOLY 指令接手  ===> LwPolyLine