继续多线段，看似简单，但很有用
本帖最后由 wzg356 于 2014-9-13 19:25 编辑这个小工具，很小众，但对我很有用。找了好久，没找到，自己动手写了。
改了好几个版本，这个觉得还可以，分享给需要的盆友
附件更新POLYLINE无颜色组码62时的出错
解决3楼dbx511提出的 lwPOLYLINE 继续时按c闭合问题，已更新;;;wzg写于2014年3月22日，改了几版，完善在9月5日，还有待完善简化
(defun c:pl-jx ( / oce1 oce2 oce3 oce4 oce5 vxs ss en ent en1 lst pt lw)
;;;系统变量
(command "undo" "be");;命令编组开始
(setqoce1 (getvar "cmdecho");;;保存命令响应原变量值
oce2 (getvar "PLINEWID");;全局线宽
oce3 (getvar "OSMODE");;;捕捉变量
oce4 (getvar "CECOLOR");;绘图颜色
oce5 (getvar "LWDEFAULT");;线宽
)
(setvar "cmdecho" 0);;;关闭命令响应
(setvar "OSMODE" 39);;;改变捕捉模式
(setvar "PLINETYPE" 2);;;高质量对线段
;;;子函数
(defun vxs (e / i v lst);;示例(vxs (car (entsel))),返回三维点坐标
(setq i -1)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst)
)
;;;主程序
(setq SS (entsel "\n请点取要继续的多线线:"))
(setq en (car SS))
(setq ent (entget en))
(if(or (= (cdr (assoc 0 ent)) "POLYLINE") (= (cdr (assoc 0 ent)) "LWPOLYLINE"))
(progn
(setq lst (vxs en))
(if (= (cdr (assoc 0 ent)) "POLYLINE")
(progn;继续POLYLINE
(if(/= (assoc 62 ent)nil)
(setvar "CECOLOR" (rtos(cdr (assoc 62 ent)) 2 0))
(setvar "CECOLOR" "BYLAYER")
)
(if(/= (assoc 370 ent)nil)(setvar "LWDEFAULT" (cdr (assoc 370 ent))))
(command "3dpoly" );注意以下三句的写法
(foreach pt lst (command pt))
(while(/=(getvar"cmdactive")0)(command pause))
(setq en1 (entlast))
(command "_matchprop"en en1 "")
(command "_erase"en"")
)
(progn;继续LWPOLYLINE
(setq lw (cdr (assoc 43 ent)));实体全局线宽
(if (= lw nil) (setq lw (cdr (assoc 40 ent))));如果无实体全局线宽则取起始线宽
(setq pt (last lst));获取末端点坐标
;注意以下2句的写法
(command "pline"pt "w" lw lw)
(while(/=(getvar"cmdactive")0)
(cond
((or(equal (grread t 8) '(2 67))(equal (grread t 8) '(2 99)))(command (car lst) ""));按下c/C键闭合
((= (car (grread t 8)) 11) (command ""));按下鼠标右键结束
(t (command pause))
)
)
(setq en1 (entlast))
(command "_matchprop"en en1 "")
(command "_join"en1 en "")
)
)
)
(alert "你选择的不是多线段!")
)
;;;还原系统变量值
(setvar "cmdecho" oce1);;;恢复命令响应
(setvar "PLINEWID" oce2);;全局线宽
(setvar "OSMODE" oce3);;;恢复捕捉模式
(setvar "CECOLOR" oce4)
(setvar "LWDEFAULT" oce5)
(command "undo" "e")
(princ)
)
liuhaixin88 发表于 2014-9-16 17:42
这个继续多段线应该最完善了，可选择起端末端，闭合也正确~ 很好→很棒！很好~很棒！！很好……很棒！！！ 不错，很实用，不过有弧度的该如何处理 自己坐板凳 本帖最后由 dbx511 于 2014-9-13 16:01 编辑
这个很不错阿。非常不错！另外有点小小的建议，如果把之前画的多义线break,或者trim最后画的那一段后，（就是去掉了原来多义线的最后一个端点或几个端点含最后一个端点）用这个命令继续画的画，继续画的多义线的圆弧就没法和之前原多义线修剪修改后的最后一个点或最后几个点的剩下部分的多义线圆滑连接。估计是修改原多义线后最后一个点的连续的方位角改变了。希望能考虑这种情况，增加判断继续画的之前那个多义线如果有修改，（最后一个点或几个点被修改掉后），能重新判断之前那个修改后的多义线的最后一个点的相关参数，使继续画的部分能和其圆滑连接。谢谢！ 本帖最后由 wzg356 于 2014-9-13 19:26 编辑
wzg356 发表于 2014-9-13 10:18 static/image/common/back.gif
自己坐板凳
继续POLYLINE 可以输入c闭合.
LWPOLYLINE 输入c闭合 已解决，代码已更新 直接comand pl 然后再 coammand FILLET 应该也能达到效果 就是平行的时候可能不行 我也来凑个热闹，对楼主的分享精神要表扬！
对多段线接着画，应该可以选择是从起始端开始画，还是终点开始画。
这个问题之前有讨论过，E大之前给过源码，希望给楼主一个参考。
;;http://bbs.mjtd.com/thread-107695-2-1.html
;;by edata
(defun c:tt (/ ss obj end_pt pt c_flag n ch_start ch_close ch_open)
(vl-load-com)
(if (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE"))))
(progn
(sssetfirst nil ss)
(setq obj (vlax-ename->vla-object (ssname ss 0))
ch_close nil
ch_start nil
;;; ch_open nil
)
(setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
(while (and (not ch_close)
(car (list t (initget "S E C O _start end close open" )))
(setq pt (getpoint end_pt "\n指定下一点:"))
) ;_ end of and
(cond
((= (type pt) 'list)
(setq pt(trans pt 1 0))
(if (vlax-curve-isClosed obj)
(setq n (fix (1- (vlax-curve-getendParam obj)))
c_flag t
) ;_ end of setq
(setq n (fix (vlax-curve-getendParam obj))
c_flag nil
) ;_ end of setq
) ;_ end of if
(if (or ch_start c_flag )
(progn
(vla-addvertex
obj
0
(vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble '(0 . 1))
(list (car pt) (cadr pt))
) ;_ end of vlax-safearray-fill
) ;_ end of vla-addvertex
(setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
) ;_ end of progn
(progn
(vla-addvertex
obj
(1+ n)
(vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble '(0 . 1))
(list (car pt) (cadr pt))
) ;_ end of vlax-safearray-fill
) ;_ end of vla-addvertex
(setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
) ;_ end of progn
) ;_ end of if
)
((and (= (type pt) 'str)(= pt "start"))
(setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
(setq ch_start t)
)
((and (= (type pt) 'str)(= pt "end"))
(setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
(setq ch_start nil)
)
((and (= (type pt) 'str)(= pt "close"))
(if (not(vlax-curve-isClosed obj))
(vla-put-closed obj 1))
(setq ch_close t)
)
((and (= (type pt) 'str)(= pt "open"))
(if (vlax-curve-isClosed obj)
(vla-put-closed obj 0))
;;; (setq ch_open t)
)
) ;_ end of cond
) ;_ end of while
) ;_ end of progn
) ;_ end of if
(sssetfirst nil)
(princ)
) ;_ end of defun lucas_3333 的源码，好象多义线只能画直线段，不能画弧线段。谢谢wzg356 的修改，不过好象比如在原多义线画完后，用了别的命令画了其他的线或者圆弧后，在用继续画的那个程序，画出来的线的弧段和原来的多义线不能圆滑链接。 程序很实用，感谢楼主！ 程序很实用但是里面存着一个问题就是，能不能换方向啊，假设一条直线利用程序继续画线的那个端点不是我想继续画的线的另一头是我想画的能不能加一个可以换方向的自定义函数就更完美了期待高作