求助：求在已有多义线上接着画的代码 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

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

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

liu_kunlun 发表于 2014-1-5 17:56:01

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

adc 发表于 2014-1-12 21:49:54

edata 发表于 2014-1-4 15:37 static/image/common/back.gif

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

edata 发表于 2014-1-12 22:02:06

本帖最后由 edata 于 2014-1-12 22:06 编辑

adc 发表于 2014-1-12 21:49 static/image/common/back.gif
怎样在自定义ucs下可以使用？
你试试。(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

adc 发表于 2014-1-12 22:31:17

edata 发表于 2014-1-12 22:02 static/image/common/back.gif
你试试。

非常感谢！！！

众山小 发表于 2014-1-13 08:10:55

非常实用程序！

dbx511 发表于 2014-2-3 11:50:28

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

xyp1964 发表于 2014-2-3 12:47:26

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

自贡黄明儒 发表于 2014-12-27 20:24:29

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

原多段线有弧怎么办？

llsheng_73 发表于 2014-12-28 06:16:53

自贡黄明儒发表于 2014-12-27 20:24 static/image/common/back.gif
原多段线有弧怎么办？

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

页: 1 [2] 3 4

明经CAD社区's Archiver