我告诉过你这是部分解决方案。
现在，您可以使用新高程构建坐标列表
然后制作3D多边形。
这里有一个由艾伦J汤普森，将entmake你的3dpoly例程。
您提供了一个点列表：
;; entmake a 3dpoly by AlanJT ;
(defun _pline (lst)
(if (and (> (length lst) 1)
(entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . ))
(foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
)
(cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
)
)
ymg公司 谢谢你ymg3 试试这个制作3D多边形。
(defun c:chgpoly ( )
(setq en1 (car (entsel"\nSelect Polyline: "))
pl (listpol en1)
ss (ssget "_F" pl '((0 . "INSERT")))
lst nil
)
(repeat (setq i (sslength ss))
(setq blk (ssname ss (setq i (1- i)))
enb (entget blk)
ipt (cdr (assoc 10 enb))
en (entnext blk)
enl (entget en)
)
(while (= (cdr (assoc 0 enl)) "ATTRIB")
(if (= (cdr (assoc 2 enl)) "ELEV")
(progn
(setqp (list (car ipt) (cadr ipt) (atof (cdr (assoc 1 enl))))
lst (cons p lst)
)
)
)
(setq en (entnext en) enl (entget en))
)
)
(if (vlax-curve-IsClosed en1) (setq lst (cons (last lst) lst)))
(_pline lst)
(entdel en1)
)
;; entmake a 3dpoly by Alan J Thompson ;
(defun _pline (lst)
(if (and (> (length lst) 1)
(entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . ))
(foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
)
(cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
)
)
;; List vertices of a polylineOriginal code by Gile Chanteau ;
(defun listpol (en / i p l)
(setq i (if (vlax-curve-IsClosed en)
(vlax-curve-getEndParam en)
(+ (vlax-curve-getEndParam en) 1)
)
)
(while (setq p (vlax-curve-getPointAtParam en (setq i (1- i))))
(setq l (cons p l))
)
)
谢谢你，ymg3很好用。。。
嗨，prodromosm，
将以下代码视为“快速而肮脏的演示，而不是最终确定的代码”，并将其视为实现目标的不同方法。
这个“演示”应该在WCS中按预期工作。。。
使用demo1，您只需选择连接所有“点”块的LWMOLYLINE（2D），即可生成具有“ELEV”信息的3D多段线。
(defun c:demo1 (/ attlst e lst obj par poly pt s s1 z)
(if (setq s (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
(progn
(vl-cmdf "_.DRAWORDER"(ssname s 0) "" "_B"
"_.zoom" "_O" (ssname s 0) ""
"_.-layer" "_M" "3DPoly_Test" "_C" "3" "3DPoly_Test" "" ""
);; vl-cmdf
(setq poly (vlax-ename->vla-object (ssname s 0))
e (fix (vlax-curve-getEndParam poly))
par 0
lst nil
);; setq
(while (/= par (1+ e))
(setq pt (vlax-curve-getPointAtParam poly par))
(if (setq s1 (ssget pt '((0 . "INSERT") (2 . "Point") (66 . 1))))
(progn
(setq obj (vlax-ename->vla-object (ssname s1 0))
attlst (vlax-invoke obj 'GetAttributes)
);; setq
(foreach att attlst
(if (= (vla-get-TagString att) "ELEV")
(setq z (atof (vla-get-TextString att))
pt(list (car pt) (cadr pt) z)
lst (cons pt lst)
);; setq
);; if
);; foreach
);; progn
);; if
(setq par (1+ par))
);; while
(if lst
(progn
(setq lst (reverse lst))
(entmake (list '(0 . "POLYLINE")
(if (vlax-curve-IsClosed poly)
'(70 . 9)
'(70 .
);; if
);; list
);; entmake
(foreach x lst
(entmake (list '(0 . "VERTEX")
'(70 . 32)
(cons 10 x)
);; list
);; entmake
);; foreach
(entmake '((0 . "SEQEND")))
);; progn
);; if
(vl-cmdf "_.zoom" "_P")
);; progn
);; if
(princ)
);; demo1
在演示2中，您只需要选择连接所有“点”块的3DPolyline，以使用高程值填充“高程”“标记”。
(defun c:demo2 (/ attlst e obj par poly pt s s1 )
(if (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
(progn
(vl-cmdf "_.DRAWORDER" (ssname s 0) "" "_B"
"_.zoom" "_O" (ssname s 0) ""
);; vl-cmdf
(setq poly (vlax-ename->vla-object (ssname s 0))
e (fix (vlax-curve-getEndParam poly))
par 0
);; setq
(while (/= par (1+ e))
(setq pt (vlax-curve-getPointAtParam poly par))
(if (setq s1 (ssget pt '((0 . "INSERT") (2 . "Point") (66 . 1))))
(progn
(setq obj (vlax-ename->vla-object (ssname s1 0))
attlst (vlax-invoke obj 'GetAttributes)
);; setq
(foreach att attlst
(if (= (vla-get-TagString att) "ELEV")
(vla-put-TextString att (rtos (caddr pt) 2 2))
);; if
);; foreach
);; progn
);; if
(setq par (1+ par))
);; while
(vl-cmdf "_.zoom" "_P")
);; progn
);; if
(princ)
);; demo2
希望这有帮助。。。
亨里克 谢谢你，干得好。我还有一个问题
我正在搜索lisp以将三维多段线转换为多段线。到目前为止，我找到的所有lisp都将三维多段线转换为二维多段线，但不会转换为多段线。当我在“属性”选项板中选择多段线时，我的意思是写多段线而不是二维多段线。
你能帮忙吗？
这是我说的lisp，但是当我选择多段线时，比如说2d多段线，而不仅仅是多段线。
;;CADALYST 09/03 AutoLISP Solutions
;;; PLINE-3D-2D.LSP - a program to convert
;;; 3D polylines to 2D
;;; Program by Tony Hotchkiss
(defun pline-3d-2d ()
(vl-load-com)
(setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
) ;_ end of vla-get-activedocument
*modelspace*(vla-get-ModelSpace *thisdrawing*)
) ;_ end of setq
(setq 3d-pl-list
(get-3D-pline)
) ;_ end of setq
(if 3d-pl-list
(progn
(setq vert-array-list (make-list 3d-pl-list))
(setq n (- 1))
(repeat (length vert-array-list)
(setq vert-array (nth (setq n (1+ n)) vert-array-list))
(setq lyr (vlax-get-property (nth n 3d-pl-list) 'Layer))
(setq obj (vla-AddPolyline *modelspace* vert-array))
(vlax-put-property obj 'Layer lyr)
) ;_ end of repeat
(foreach obj 3d-pl-list (vla-delete obj))
) ;_ end of progn
) ;_ end of if
) ;_ end of pline-3d-2d
(defun get-3D-pline ()
(setq pl3dobj-list nil
obj nil
3d "AcDb3dPolyline"
) ;_ end of setq
(setq selsets (vla-get-selectionsets *thisdrawing*))
(setq ss1 (vlax-make-variant "ss1"))
(if (= (vla-get-count selsets) 0)
(setq ssobj (vla-add selsets ss1))
) ;_ end of if
(vla-clear ssobj)
(setq Filterdata (vlax-make-variant "POLYLINE"))
(setq no-ent 1)
(while no-ent
(vla-Selectonscreen ssobj)
(if (> (vla-get-count ssobj) 0)
(progn
(setq no-ent nil)
(setq i (- 1))
(repeat (vla-get-count ssobj)
(setq
obj (vla-item ssobj
(vlax-make-variant (setq i (1+ i)))
) ;_ end of vla-item
) ;_ end of setq
(cond
((= (vlax-get-property obj "ObjectName") 3d)
(setq pl3dobj-list
(append pl3dobj-list (list obj))
) ;_ end of setq
)
) ;_ end-of cond
) ;_ end of repeat
) ;_ end of progn
(prompt "\nNo entities selected, try again.")
) ;_ end of if
(if (and (= nil no-ent) (= nil pl3dobj-list))
(progn
(setq no-ent 1)
(prompt "\nNo 3D-polylines selected.")
(quit)
) ;_ end of progn
) ;_ end of if
) ;_ end of while
(vla-delete (vla-item selsets 0))
pl3dobj-list
) ;_ end of get-3D-pline
(defun get-3D-pline-old ()
(setq no-ent 1)
(setq filter '((-4 . "<AND")
(0 . "POLYLINE")
(70 .
(-4 . "AND>")
)
) ;_ end of setq
(while no-ent
(setq ss (ssget filter)
k (- 1)
pl3dobj-list nil
obj nil
3d "AcDb3dPolyline"
) ;_ end-of setq
(if ss
(progn
(setq no-ent nil)
(repeat (sslength ss)
(setq ent (ssname ss (setq k (1+ k)))
obj (vlax-ename->vla-object ent)
) ;_ end-of setq
(cond
((= (vlax-get-property obj "ObjectName") 3d)
(setq pl3dobj-list
(append pl3dobj-list (list obj))
) ;_ end of setq
)
) ;_ end-of cond
) ;_ end-of repeat
) ;_ end-of progn
(prompt "\nNo 3D-polylines selected, try again.")
) ;_ end-of if
) ;_ end-of while
pl3dobj-list
) ;_ end of get-3D-pline-old
(defun make-list (p-list)
(setq i (- 1)
vlist nil
calist nil
) ;_ end of setq
(repeat (length p-list)
(setq obj (nth (setq i (1+ i)) p-list)
coords (vlax-get-property obj "coordinates")
ca (vlax-variant-value coords)
) ;_ end-of setq
(setq calist (append calist (list ca)))
) ;_ end-of repeat
) ;_ end-of make-list
(defun c:pl32 ()
(pline-3d-2d)
(princ)
) ;_ end of pl32
(prompt "Enter PL32 to start: ")
佩德罗，
我不明白你为什么要这样做，但是，listpol例程
将为您提供任何类型的多段线或lwpoly的顶点。只需应用退货列表
按照AlanJT的惯例。
ymg公司
不客气，prodromosm！
我们不能转换二维多段线，也不能转换lwpolyline中的三维多段线，我们可以做的是选择一条二维/三维多段线，将vértices点合并，用以前的数据生成一条新的lwpolyline，并输入原始多段线。。。
作为演示，如果多段线有弧，将失败，并且不会删除原始多段线，只是一个起点。。。
(defun c:demo3 (/ E ELV LST PAR POLY PT PT0 LST S X ZDIR)
(vl-load-com)
(if (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") )))
(progn
(setq poly (vlax-ename->vla-object (ssname s 0))
e (fix (vlax-curve-getEndParam poly))
par 0
lst nil
);; setq
(while (/= par (1+ e))
(setq pt(vlax-curve-getPointAtParam poly par)
pt0 (list (car pt) (cadr pt) 0.0)
lst (cons pt0 lst)
);; setq
(setq par (1+ par))
);; while
(if lst
(progn
(setq lst(reverse lst)
zdir (trans '(0 0 1) 1 0 T)
elv(caddr (trans (car lst) 1 zdir))
);; setq
(entmake
(append
(list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
;(cons 8 "YourLayer")
;(cons 62 "YourColor")
(cons 100 "AcDbPolyline")
(cons 90 (length lst))
(if (vlax-curve-IsClosed poly)
'(70 . 1)
'(70 . 0)
);; if
(cons 38 elv)
;(cons 43 "YourWidth)
(cons 210 zdir)
);; list
(mapcar '(lambda (x) (cons 10 (trans x 1 zdir))) lst)
);; append
);; entmake
);; progn
);; if
);; progn
);; if
(princ)
);; demo3
HTH公司
亨里克 我无法理解你的答案。我和post pline-3d-2d lisp无法理解为什么将三维多段线转换为二维多段线而不是简单的多段线。有可能改变吗？
谢谢 谢谢你hmsilva
页:
1
[2]