继续多线段，看似简单，但很有用

wzg356

这个小工具，很小众，但对我很有用。找了好久，没找到，自己动手写了。
改了好几个版本，这个觉得还可以，分享给需要的盆友

附件更新POLYLINE  无颜色组码62时的出错

解决3楼dbx511提出的 lwPOLYLINE 继续时按c闭合问题，已更新

2. ;;;wzg写于2014年3月22日，改了几版，完善在9月5日，还有待完善简化
   
3. (defun c:pl-jx ( / oce1 oce2 oce3 oce4 oce5 vxs ss en ent en1 lst pt lw)
   
4.   ;;;系统变量
   
5.   (command "undo" "be");;命令编组开始
   
6.   (setq  oce1 (getvar "cmdecho");;;保存命令响应原变量值
   
7.         oce2 (getvar "PLINEWID");;全局线宽
   
8.       oce3 (getvar "OSMODE");;;捕捉变量
   
9.       oce4 (getvar "CECOLOR");;绘图颜色
   
10.       oce5 (getvar "LWDEFAULT");;线宽
    
11.   )
    
12.   (setvar "cmdecho" 0);;;关闭命令响应
    
13.   (setvar "OSMODE" 39);;;改变捕捉模式
    
14.   (setvar "PLINETYPE" 2);;;高质量对线段
    
15.   
    
16. ;;;子函数
    
17.   (defun vxs (e / i v lst);;示例(vxs (car (entsel))),返回三维点坐标
    
18.     (setq i -1)
    
19.     (while
    
20.       (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
    
21.       (setq lst (cons v lst))
    
22.     )
    
23.     (reverse lst)
    
24.   )  
    
25.   
    
26. ;;;主程序
    
27.   (setq SS (entsel "\n请点取要继续的多线线:"))  
    
28.   (setq en (car SS))
    
29.   (setq ent (entget en))  
    
30.   (if  (or (= (cdr (assoc 0 ent)) "POLYLINE") (= (cdr (assoc 0 ent)) "LWPOLYLINE"))
    
31.       (progn
    
32.         (setq lst (vxs en))
    
33.         (if (= (cdr (assoc 0 ent)) "POLYLINE")
    
34.           (progn;继续POLYLINE
    
35.             (if(/= (assoc 62 ent)nil)
    
36.               (setvar "CECOLOR" (rtos(cdr (assoc 62 ent)) 2 0))
    
37.               (setvar "CECOLOR" "BYLAYER")
    
38.           )
    
39.             (if(/= (assoc 370 ent)nil)(setvar "LWDEFAULT" (cdr (assoc 370 ent))))            
    
40.             (command "3dpoly" );注意以下三句的写法
    
41.             (foreach pt lst (command pt))
    
42.             (while(/=(getvar"cmdactive")0)(command pause))
    
43.             (setq en1 (entlast))            
    
44.                 (command "_matchprop"  en en1 "")
    
45.                 (command "_erase"  en"")
    
46.           )
    
47.           (progn;继续LWPOLYLINE
    
48.             (setq lw (cdr (assoc 43 ent)));实体全局线宽
    
49.             (if (= lw nil) (setq lw (cdr (assoc 40 ent))));如果无实体全局线宽  则取起始线宽
    
50.             (setq pt (last lst));获取末端点坐标
    
51.             ;注意以下2句的写法
    
52.             (command "pline"  pt "w" lw lw)
    
53.             (while(/=(getvar"cmdactive")0)
    
54.               (cond
    
55.                 ((or(equal (grread t 8) '(2 67))(equal (grread t 8) '(2 99)))(command (car lst) ""));按下c/C键闭合
    
56.                 ((= (car (grread t 8)) 11) (command ""));按下鼠标右键结束
    
57.                   (t (command pause))
    
58.               )
    
59.             )
    
60.             (setq en1 (entlast))
    
61.             (command "_matchprop"  en en1 "")
    
62.             (command "_join"  en1 en "")
    
63.           )
    
64.         )
    
65.         )
    
66.         (alert "你选择的不是多线段!")
    
67.   )
    
68.   ;;;还原系统变量值
    
69.     (setvar "cmdecho" oce1);;;恢复命令响应
    
70.     (setvar "PLINEWID" oce2);;全局线宽
    
71.     (setvar "OSMODE" oce3);;;恢复捕捉模式  
    
72.     (setvar "CECOLOR" oce4)
    
73.     (setvar "LWDEFAULT" oce5)
    
74.     (command "undo" "e")   
    
75.     (princ)
    
76. )
    

;;;wzg写于2014年3月22日，改了几版，完善在9月5日，还有待完善简化<br /> (defun c:pl-jx ( / oce1 oce2 oce3 oce4 oce5 vxs ss en ent en1 lst pt lw)<br />   ;;;系统变量<br />   (command "undo" "be");;命令编组开始<br />   (setq  oce1 (getvar "cmdecho");;;保存命令响应原变量值<br />         oce2 (getvar "PLINEWID");;全局线宽<br />       oce3 (getvar "OSMODE");;;捕捉变量<br />       oce4 (getvar "CECOLOR");;绘图颜色<br />       oce5 (getvar "LWDEFAULT");;线宽<br />   )<br />   (setvar "cmdecho" 0);;;关闭命令响应<br />   (setvar "OSMODE" 39);;;改变捕捉模式<br />   (setvar "PLINETYPE" 2);;;高质量对线段<br />   <br /> ;;;子函数<br />   (defun vxs (e / i v lst);;示例(vxs (car (entsel))),返回三维点坐标<br />     (setq i -1)<br />     (while<br />       (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />       (setq lst (cons v lst))<br />     )<br />     (reverse lst)<br />   )  <br />   <br /> ;;;主程序<br />   (setq SS (entsel "\n请点取要继续的多线线:"))  <br />   (setq en (car SS))<br />   (setq ent (entget en))  <br />   (if  (or (= (cdr (assoc 0 ent)) "POLYLINE") (= (cdr (assoc 0 ent)) "LWPOLYLINE"))<br />       (progn<br />         (setq lst (vxs en))<br />         (if (= (cdr (assoc 0 ent)) "POLYLINE")<br />           (progn;继续POLYLINE<br />             (if(/= (assoc 62 ent)nil)<br />               (setvar "CECOLOR" (rtos(cdr (assoc 62 ent)) 2 0))<br />               (setvar "CECOLOR" "BYLAYER")<br />           )<br />             (if(/= (assoc 370 ent)nil)(setvar "LWDEFAULT" (cdr (assoc 370 ent))))            <br />             (command "3dpoly" );注意以下三句的写法<br />             (foreach pt lst (command pt)) <br />             (while(/=(getvar"cmdactive")0)(command pause))<br />             (setq en1 (entlast))            <br />                 (command "_matchprop"  en en1 "")<br />                 (command "_erase"  en"")<br />           )<br />           (progn;继续LWPOLYLINE<br />             (setq lw (cdr (assoc 43 ent)));实体全局线宽<br />             (if (= lw nil) (setq lw (cdr (assoc 40 ent))));如果无实体全局线宽  则取起始线宽<br />             (setq pt (last lst));获取末端点坐标<br />             ;注意以下2句的写法<br />             (command "pline"  pt "w" lw lw)<br />             (while(/=(getvar"cmdactive")0)<br />               (cond <br />                 ((or(equal (grread t 8) '(2 67))(equal (grread t 8) '(2 99)))(command (car lst) ""));按下c/C键闭合<br />                 ((= (car (grread t 8)) 11) (command ""));按下鼠标右键结束<br />                   (t (command pause))<br />               )<br />             )<br />             (setq en1 (entlast))<br />             (command "_matchprop"  en en1 "")<br />             (command "_join"  en1 en "")<br />           )<br />         )<br />         )<br />         (alert "你选择的不是多线段!")<br />   )<br />   ;;;还原系统变量值<br />     (setvar "cmdecho" oce1);;;恢复命令响应<br />     (setvar "PLINEWID" oce2);;全局线宽<br />     (setvar "OSMODE" oce3);;;恢复捕捉模式  <br />     (setvar "CECOLOR" oce4) <br />     (setvar "LWDEFAULT" oce5)<br />     (command "undo" "e")    <br />     (princ)<br /> )<br />

1. 
   

复制代码

weijiewen

liuhaixin88 发表于 2014-9-16 17:42

这个继续多段线应该最完善了，可选择起端末端，闭合也正确~

firstinti

不错，很实用，不过有弧度的该如何处理

wzg356

自己坐板凳

dbx511

这个很不错阿。非常不错！另外有点小小的建议，如果把之前画的多义线break,或者trim最后画的那一段后，（就是去掉了原来多义线的最后一个端点或几个端点含最后一个端点）用这个命令继续画的画，继续画的多义线的圆弧就没法和之前原多义线修剪修改后的最后一个点或最后几个点的剩下部分的多义线圆滑连接。估计是修改原多义线后最后一个点的连续的方位角改变了。希望能考虑这种情况，增加判断继续画的之前那个多义线如果有修改，（最后一个点或几个点被修改掉后），能重新判断之前那个修改后的多义线的最后一个点的相关参数，使继续画的部分能和其圆滑连接。谢谢！

wzg356

wzg356 发表于 2014-9-13 10:18
自己坐板凳

继续POLYLINE 可以输入c闭合.
LWPOLYLINE 输入c闭合 已解决，代码已更新

aihuyujian

直接comand pl 然后再 coammand FILLET 应该也能达到效果 就是平行的时候可能不行

lucas_3333

我也来凑个热闹，对楼主的分享精神要表扬！
对多段线接着画，应该可以选择是从起始端开始画，还是终点开始画。
这个问题之前有讨论过，E大之前给过源码，希望给楼主一个参考。

1. ;;http://bbs.mjtd.com/thread-107695-2-1.html
   
2. ;;by edata
   
3. (defun c:tt (/ ss obj end_pt pt c_flag n ch_start ch_close ch_open)
   
4.   (vl-load-com)
   
5.   (if (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE"))))
   
6.     (progn
   
7.       (sssetfirst nil ss)
   
8.       (setq obj (vlax-ename->vla-object (ssname ss 0))
   
9.             ch_close nil
   
10.             ch_start nil
    
11. ;;;            ch_open nil
    
12.             )
    
13.       (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
    
14.       (while (and (not ch_close)
    
15.                   (car (list t (initget "S E C O _start end close open" )))
    
16.                   (setq pt (getpoint end_pt "\n指定下一点[S从起点开始/E从终点开始/C闭合/O打开]:"))
    
17.              ) ;_ end of and
    
18.         (cond
    
19.           ((= (type pt) 'list)
    
20.      (setq pt(trans pt 1 0))
    
21.            (if (vlax-curve-isClosed obj)
    
22.              (setq n          (fix (1- (vlax-curve-getendParam obj)))
    
23.                    c_flag t
    
24.              ) ;_ end of setq
    
25.              (setq n          (fix (vlax-curve-getendParam obj))
    
26.                    c_flag nil
    
27.              ) ;_ end of setq
    
28.            ) ;_ end of if
    
29.            (if (or ch_start c_flag )
    
30.              (progn
    
31.                (vla-addvertex
    
32.                  obj
    
33.                  0
    
34.                  (vlax-safearray-fill
    
35.                    (vlax-make-safearray vlax-vbDouble '(0 . 1))
    
36.                    (list (car pt) (cadr pt))
    
37.                  ) ;_ end of vlax-safearray-fill
    
38.                ) ;_ end of vla-addvertex
    
39.                (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
    
40.              ) ;_ end of progn
    
41.              (progn
    
42.                (vla-addvertex
    
43.                  obj
    
44.                  (1+ n)
    
45.                  (vlax-safearray-fill
    
46.                    (vlax-make-safearray vlax-vbDouble '(0 . 1))
    
47.                    (list (car pt) (cadr pt))
    
48.                  ) ;_ end of vlax-safearray-fill
    
49.                ) ;_ end of vla-addvertex
    
50.                (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
    
51.              ) ;_ end of progn
    
52.            ) ;_ end of if
    
53.           )
    
54.           ((and (= (type pt) 'str)(= pt "start"))
    
55.            (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
    
56.            (setq ch_start t)
    
57.            )
    
58.           ((and (= (type pt) 'str)(= pt "end"))
    
59.            (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
    
60.            (setq ch_start nil)           
    
61.            )
    
62.           ((and (= (type pt) 'str)(= pt "close"))
    
63.            (if (not(vlax-curve-isClosed obj))
    
64.              (vla-put-closed obj 1))
    
65.            (setq ch_close t)           
    
66.            )
    
67.           ((and (= (type pt) 'str)(= pt "open"))
    
68.            (if (vlax-curve-isClosed obj)
    
69.              (vla-put-closed obj 0))
    
70. ;;;           (setq ch_open t)           
    
71.            )
    
72.         ) ;_ end of cond
    
73.       ) ;_ end of while
    
74.     ) ;_ end of progn
    
75.   ) ;_ end of if
    
76.   (sssetfirst nil)
    
77.   (princ)
    
78. ) ;_ end of defun

;;<a href="http://bbs.mjtd.com/thread-107695-2-1.html" target="_blank">http://bbs.mjtd.com/thread-107695-2-1.html</a><br /> ;;by edata<br /> (defun c:tt (/ ss obj end_pt pt c_flag n ch_start ch_close ch_open)<br />   (vl-load-com)<br />   (if (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE"))))<br />     (progn<br />       (sssetfirst nil ss)<br />       (setq obj (vlax-ename->vla-object (ssname ss 0))<br />             ch_close nil<br />             ch_start nil<br /> ;;;            ch_open nil<br />             )<br />       (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))<br />       (while (and (not ch_close)<br />                   (car (list t (initget "S E C O _start end close open" )))<br />                   (setq pt (getpoint end_pt "\n指定下一点[S从起点开始/E从终点开始/C闭合/O打开]:"))<br />              ) ;_ end of and<br />         (cond<br />           ((= (type pt) 'list)<br />      (setq pt(trans pt 1 0))<br />            (if (vlax-curve-isClosed obj)<br />              (setq n          (fix (1- (vlax-curve-getendParam obj)))<br />                    c_flag t<br />              ) ;_ end of setq<br />              (setq n          (fix (vlax-curve-getendParam obj))<br />                    c_flag nil<br />              ) ;_ end of setq<br />            ) ;_ end of if<br />            (if (or ch_start c_flag )<br />              (progn<br />                (vla-addvertex<br />                  obj<br />                  0<br />                  (vlax-safearray-fill<br />                    (vlax-make-safearray vlax-vbDouble '(0 . 1))<br />                    (list (car pt) (cadr pt))<br />                  ) ;_ end of vlax-safearray-fill<br />                ) ;_ end of vla-addvertex<br />                (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))<br />              ) ;_ end of progn<br />              (progn<br />                (vla-addvertex<br />                  obj<br />                  (1+ n)<br />                  (vlax-safearray-fill<br />                    (vlax-make-safearray vlax-vbDouble '(0 . 1))<br />                    (list (car pt) (cadr pt))<br />                  ) ;_ end of vlax-safearray-fill<br />                ) ;_ end of vla-addvertex<br />                (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))<br />              ) ;_ end of progn<br />            ) ;_ end of if<br />           )<br />           ((and (= (type pt) 'str)(= pt "start"))<br />            (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))<br />            (setq ch_start t)<br />            )<br />           ((and (= (type pt) 'str)(= pt "end"))<br />            (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))<br />            (setq ch_start nil)           <br />            )<br />           ((and (= (type pt) 'str)(= pt "close"))<br />            (if (not(vlax-curve-isClosed obj))<br />              (vla-put-closed obj 1))<br />            (setq ch_close t)           <br />            )<br />           ((and (= (type pt) 'str)(= pt "open"))<br />            (if (vlax-curve-isClosed obj)<br />              (vla-put-closed obj 0))<br /> ;;;           (setq ch_open t)           <br />            )<br />         ) ;_ end of cond<br />       ) ;_ end of while<br />     ) ;_ end of progn<br />   ) ;_ end of if<br />   (sssetfirst nil)<br />   (princ)<br /> ) ;_ end of defun

dbx511

lucas_3333 的源码，好象多义线只能画直线段，不能画弧线段。谢谢wzg356 的修改，不过好象比如在原多义线画完后，用了别的命令画了其他的线或者圆弧后，在用继续画的那个程序，画出来的线的弧段和原来的多义线不能圆滑链接。

USER2128

程序很实用，感谢楼主！

杜阳

程序很实用  但是里面存着一个问题就是，能不能换方向啊，假设一条直线  利用程序继续画线的那个端点不是我想继续画的  线的另一头是我想画的  能不能加一个可以换方向的自定义函数  就更完美了  期待高作