求助：求在已有多义线上接着画的代码

edata

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

(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 (vlax-curve-getEndPoint OBJ))<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 />            (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 (vlax-curve-getStartPoint OBJ))<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 (vlax-curve-getEndPoint OBJ))<br />              ) ;_ end of progn<br />            ) ;_ end of if<br />           )<br />           ((and (= (type pt) 'str)(= pt "start"))<br />            (setq end_pt (vlax-curve-getStartPoint OBJ))<br />            (setq ch_start t)<br />            )<br />           ((and (= (type pt) 'str)(= pt "end"))<br />            (setq end_pt (vlax-curve-getEndPoint OBJ))<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

liu_kunlun

顶一个，pline的编辑确实不太方便。

adc

edata 发表于 2014-1-4 15:37

怎样在自定义ucs下可以使用？

edata

adc 发表于 2014-1-12 21:49
怎样在自定义ucs下可以使用？

你试试。

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

(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

adc

edata 发表于 2014-1-12 22:02
你试试。

非常感谢！！！

众山小

非常实用程序！

dbx511

能不能增加画圆滑连接的多义线的弧段的接着画功能啊?谢谢

xyp1964

2. ;; 在多段线末尾继续画线;; 需要e派工具箱(XCAD)的支持：[url]http://yunpan.cn/QXQKsW9gAPmpF[/url]
   
3. (defun c:tt ()
   
4.   (xyp-CMDLA0)
   
5.   (if (and (setq s1 (car (entsel "\n选择多段线: ")))
   
6.            (xyp-etype s1 "lwpolyline")
   
7.       )
   
8.     (progn
   
9.       (setq n (length (xyp-get-Vertexs s1 0))
   
10.             p00 (vlax-curve-getEndPoint s1)
    
11.             p0 p00
    
12.             ptn '()
    
13.       )
    
14.       (while (setq p1 (getpoint p0 "\n下一点<退出>: "))
    
15.         (setq ptn (cons p1 ptn)
    
16.               p0 p1
    
17.         )
    
18.         (xyp-Grvecs-Ptlst (append ptn (list p00)) 1)
    
19.       )
    
20.       (foreach pt (mapcar 'xyp-3d2d (reverse ptn))
    
21.         (xyp-Add-Vertex s1 n pt)
    
22.         (setq n (1+ n))
    
23.       )
    
24.       (redraw)
    
25.     )
    
26.   )
    
27.   (xyp-CMDLA1)
    
28. )

;; 在多段线末尾继续画线;; 需要e派工具箱(XCAD)的支持：[url]http://yunpan.cn/QXQKsW9gAPmpF[/url]<br /> (defun c:tt ()<br />   (xyp-CMDLA0)<br />   (if (and (setq s1 (car (entsel "\n选择多段线: ")))<br />            (xyp-etype s1 "lwpolyline")<br />       )<br />     (progn<br />       (setq n (length (xyp-get-Vertexs s1 0))<br />             p00 (vlax-curve-getEndPoint s1)<br />             p0 p00<br />             ptn '()<br />       )<br />       (while (setq p1 (getpoint p0 "\n下一点<退出>: "))<br />         (setq ptn (cons p1 ptn)<br />               p0 p1<br />         )<br />         (xyp-Grvecs-Ptlst (append ptn (list p00)) 1)<br />       )<br />       (foreach pt (mapcar 'xyp-3d2d (reverse ptn))<br />         (xyp-Add-Vertex s1 n pt)<br />         (setq n (1+ n))<br />       )<br />       (redraw)<br />     )<br />   )<br />   (xyp-CMDLA1)<br /> )

自贡黄明儒

清风明月名字 发表于 2013-9-21 09:18
就这样将就解决了这个问题
(defun C:紧接着直线型轻多义线A的后面画A (/ ent PLTYPE obj vtx vtxlst n ptl ...

原多段线有弧怎么办？

llsheng_73

自贡黄明儒 发表于 2014-12-27 20:24
原多段线有弧怎么办？

原多线段有弧倒好办，问题是接着画的时候需要画弧弄起才麻烦