三维多段线转多段线

dcl1214 · 发表于 2024-8-17 13:59:24

(defun $3dline->pline$ (3line lst / dxf p pick pl ps vt)
;三维多段线转PLINE
(or 3line
(and
(setq pick (vl-catch-all-apply 'entsel (list "请点击三维多段线")))
(progn (if (vl-catch-all-error-p pick)
(setq pick nil)
)
(setq 3line (car pick))
)
)
)
(and 3line
(setq dxf (entget 3line))
(progn
(and dxf
(= "POLYLINE" (cdr (assoc 0 dxf)))
(= (cdr (assoc 100 (vl-remove (assoc 100 dxf) dxf)))
"AcDb3dPolyline"
) ;三维多段线
(progn
(setq dxf nil)
(setq ps nil)
(setq vt (entnext 3line))
(while (= "VERTEX" (cdr (assoc 0 (entget vt))))
(setq p (cdr (assoc 10 (entget vt))))
(setq ps (cons (cons 10 p) ps))
(setq vt (entnext vt))
)
(setq ps (reverse ps))
(setq dxf (append (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length ps))
)
ps
)
)
(setq pl (vl-catch-all-apply 'entmakex (list dxf)))
(if (vl-catch-all-error-p pl)
(setq pl nil)
)
(if pl
(progn (redraw) (entdel 3line))
)
)
)
(if pl()(print "转换多段线失败"))
)
)
(if pl
pl
3line
)
)

(defun $3dline->pline$ (3line lst / dxf p pick pl ps vt) 
  ;三维多段线转PLINE 
  (or 3line 
      (and 
  (setq pick (vl-catch-all-apply 'entsel (list "请点击三维多段线"))) 
  (progn (if (vl-catch-all-error-p pick) 
     (setq pick nil) 
         ) 
         (setq 3line (car pick)) 
  ) 
      ) 
  ) 
  (and 3line 
       (setq dxf (entget 3line)) 
       (progn 
   (and dxf 
        (= "POLYLINE" (cdr (assoc 0 dxf))) 
        (= (cdr (assoc 100 (vl-remove (assoc 100 dxf) dxf))) 
     "AcDb3dPolyline" 
        )        ;三维多段线   
        (progn 
    (setq dxf nil) 
    (setq ps nil) 
    (setq vt (entnext 3line)) 
    (while (= "VERTEX" (cdr (assoc 0 (entget vt)))) 
      (setq p (cdr (assoc 10 (entget vt)))) 
      (setq ps (cons (cons 10 p) ps)) 
      (setq vt (entnext vt)) 
    ) 
    (setq ps (reverse ps)) 
    (setq dxf (append (list 
            (cons 0 "LWPOLYLINE") 
            (cons 100 "AcDbEntity") 
            (cons 100 "AcDbPolyline") 
            (cons 90 (length ps)) 
          ) 
          ps 
        ) 
    ) 
    (setq pl (vl-catch-all-apply 'entmakex (list dxf))) 
    (if (vl-catch-all-error-p pl) 
      (setq pl nil) 
    ) 
    (if pl 
      (progn (redraw) (entdel 3line)) 
    ) 
        ) 
   ) 
   (if pl()(print "转换多段线失败")) 
       ) 
  )   
  (if pl 
    pl 
    3line 
  ) 
)

树櫴希德 · 发表于 2024-8-17 15:53:18

大师威威多段线一直就是核心

tanxindong · 发表于 2024-8-22 09:25:03

大神厉害，我写了一个把多段线坐标读取到剪切板，但是运行不了，能帮看看吗？

(defun c:pte4 (/ e n i lst) ;往剪贴板写坐标
 (vl-load-com)
 (setq e (ssget '((0 . "*polyline"))))
(setq n (sslength e)
 i 0
 lst '()
 )

 (while (vla-object (ssname e i)))))
(vlax-invoke-method (vlax-get-object "Forms.DataObject") 'SetText "x\ty\t\n")
(foreach xy lst
 (vlax-invoke-method (vlax-get-object "Forms.DataObject") 'AppendText (rtos (car xy) 2 3))
 (vlax-invoke-method (vlax-get-object "Forms.DataObject") 'AppendText "\t")
 (vlax-invoke-method (vlax-get-object "Forms.DataObject") 'AppendText (rtos (cadr xy) 2 3))
 (vlax-invoke-method (vlax-get-object "Forms.DataObject") 'AppendText "\t\n")
)
(setq i (+ 1 i))
 )
 (vlax-invoke-method (vlax-get-object "Forms.DataObject") 'PutInClipboard)
 (princ)
)

(defun plinexy (obj)
 (vlax-for vertex (vla-get-Coordinates obj)
(list (car vertex) (cadr vertex))
 )
)

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

[源码] 三维多段线转多段线