polyline和lwpolyline的相互转换过程中如何保留原来的线型？

施工_G54j6

;用lisp实现polyline和lwpolyline的相互转换，可是转换后线型全变成直线了,
需要保留原有线型不变，请大神帮忙，不胜感谢！
(setq &kw (ssget '((0 . "*POLYLINE"))))
;函数如下
(defun polyline_lwpolyline (kw / &kw1 &k1 a10 a42 a70 a8 a90 ent ss1 ss2 ss5 x)
(vl-load-com)
  (if (setq &kw1 kw)      
  (progn;;1
   (setq ss1 '())
   (while (setq &k1 (ssname &kw1 0))
    (setq &kw1 (ssdel &k1 &kw1) ss1 (cons &k1 ss1))
   );while

   (if (setq ss2 (vl-remove-if-not '(lambda (x) (= (cdr (assoc 0 (entget x))) "POLYLINE")) ss1))
    (progn;;2
     (setq ss1 (vl-remove-if '(lambda (x) (member x ss2)) ss1))
     (while (setq ent (car ss2))
      (setq ss2 (cdr ss2) ss5 (s1712081 ent))
      (if (vlax-curve-isClosed ent) (setq a70 '(70 . 1)) (setq a70 '(70 . 0)))
      (setq a90 (cons 90 (length ss5))
            ss5 (apply 'append ss5)
            a8 (assoc 8 ss5)
            a10 (vl-remove-if-not '(lambda (x) (member (car x) '(10 42))) ss5)
            ss5 (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") a8 '(100 . "AcDbPolyline") a90 a70 '(38 . 0)) a10)
      )
      (entmake ss5)
      (entdel ent)
     );while
    );progn;2
   );if;2
   (if (car ss1)
    (progn
     (while (setq ent (car ss1))
      (setq ss1 (cdr ss1) ss5 (entget ent))
      (setq a70 (assoc 70 ss5)
            a8 (assoc 8 ss5)
            a10 (vl-remove-if-not '(lambda (x) (= (car x) 10)) ss5)
            a42 (vl-remove-if-not '(lambda (x) (= (car x) 42)) ss5)
            ss5 (mapcar '(lambda (x) (append (list '(0 . "VERTEX") '(100 . "AcDbEntity") '(67 . 0) a8 '(100 . "AcDbVertex") '(100 . "AcDb2dVertex")) x))
            (mapcar 'cons a10 (mapcar '(lambda (x) (list x a70)) a42)))
      )
      (s1712082 ss5 a70 a8)
      (entdel ent)
     );while
    )
   );if;3
  );progn;1
);if;1
(princ)
)


;entmake生成二维多段线
(defun s1712082 (ss5 a70 a8 / a70 a8 ed ss5)
(entmake (list  '(0 . "POLYLINE") '(100 . "AcDbEntity") a8 '(100 . "AcDb2dPolyline") a70))
(while (setq ed (car ss5))
  (setq ss5 (cdr ss5))
  (entmake ed)
)
(entmake '((0 . "SEQEND")))
)


;提取二维多段线数据
(defun s1712081 (e / e ed pts)
  (if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
    (progn
      (while (and (setq e (entnext e))
               (/= (cdr (assoc 0 (setq ed (entget e)))) "SEQEND")
             )
        (setq pts (cons ed pts))
      )
    )
  )
  (reverse pts)
)

Lisphk

转换前保存线型
转换后，设置线型

施工_G54j6

Lisphk 发表于 2019-5-14 20:56
转换前保存线型
转换后，设置线型

刚入门，看了半天不知道如何在哪加，能否有劳大神帮个忙修改下!!!

sicky111

入门了应该能写得出来。