zjy2999 发表于 2017-10-12 09:04:26

多义线线头或线尾加点（多段线接着画）

;-----------多义线线头或线尾尾加点 pladp
;-----------支持polyineLightweightPolyline
(defun c:pladp(/ pt obj pp fpa epa n newv pnt pltype vtxlst vtx vtxlst1)
(vl-load-com)
(if (setq CURVE (entsel "\n选择曲线:"))
   (progn
       (setq oob(entget (car CURVE)))
       (setq PLTYPE (cdr (assoc 0 (entget (car CURVE)))))
       (setq pt       (cadr CURVE))
       (setqOBJ(vlax-ename->vla-object (car CURVE)))
       (setqPP   (vlax-curve-getclosestpointto OBJ (trans Pt 1 0)))
       (setqfpa    (vlax-curve-getstartparam   OBJ ))             
       (setqepa    (fix (vlax-curve-getendparamOBJ )))             
       (setqN   (vlax-curve-getparamatpoint OBJ PP))
       (setq vtx (vla-get-Coordinates OBJ))
       (setq vtxlst (vlax-safearray->list (vlax-variant-value vtx)))
       (setq kk 0)
       (setq ptlst nil)
           (repeat (/ (length vtxlst) 3)
                         (setq ptlst (append ptlst (list (list (nth kk vtxlst) (nth (1+ kk) vtxlst)(nth (+ 2 kk) vtxlst) ))))
                         (setq kk (+ kk 3))
       )
       ;判断线头线尾
      (if(> N ( / (+ fpa epa) 2))
           (setq pnt(vlax-curve-getEndPointOBJ))
         (setq pnt(vlax-curve-getStartPoint OBJ))
       )
           (command "_.undo" "_BE")   
      (while(setq p (getpoint pnt "\pick增加的顶点:"))
            
            
   
         (if(= "LWPOLYLINE" PLTYPE)
                        (progn
                                        (setq p1   (list (car p) (cadr p)))
                                        (setq NEWV (vlax-safearray-fill
                                                                (vlax-make-safearray vlax-vbdouble '(0 . 1))
                                                                                                p1)
                                        )
                                        (if (> N ( / (+ fpa epa) 2))
                                                (vla-addvertex OBJ (1+(fix (vlax-curve-getendparamOBJ ))) NEWV)
                                                (vla-addvertex OBJ 0 NEWV)
                                        )
                         )
                )
                       
             (if(= "POLYLINE" PLTYPE)
                     (progn
                          (setq p1   (list (car p) (cadr p) 0) )
                          (setq NEWV (vlax-safearray-fill
                                                        (vlax-make-safearray vlax-vbdouble '(0 . 2)) p1)
                                )
                               |;
                        (if (> N ( / (+ fpa epa) 2))
                                        (progn
                                                ;(setq ptlst1(list ptlst p1))
                                                ;(vlax-put OBJ 'coordinates ptlst1);设置坐标
                                                (vla-AppendVertexOBJNEWV)
                                        )
                                        (progn
                                                  (setq vtxlst1 (cons0.0 vtxlst))
                                                  (setq vtxlst1 (cons(cadr p) vtxlst1))
                                                  (setq vtxlst1 (cons(car p) vtxlst1))
                                                  ;(setq len(length vtxlst1))
                                                  ;(setq array (vlax-make-safearray vlax-vbdouble (cons 0(- len 1))))
                                                  ;(setq satarray1 (vlax-safearray-fill array vtxlst1))
                                               ;(setq ptzb(vlax-make-variant satarray1))
                                                ;(setq ptlst1(cons p1 ptlst ))
                                                ;(vla-put-coordinate obj 0 (vlax-make-variant
                                                  ;(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 2)) p1)))
                                                (vlax-put OBJ 'coordinates vtxlst1);设置坐标
                                                (setq vtx (vla-get-Coordinates OBJ))
                                                       (setq vtxlst (vlax-safearray->list (vlax-variant-value vtx)))
                                                ;(vla-AppendVertexOBJNEWV)
                                                  ;'(1 2 3)

                      )
                          )                          
             )
          )
          (setq pnt p)
         
      )
               (command "_.undo" "_E")
))
)

lzj511 发表于 2017-10-19 22:49:09

13648893846 发表于 2017-10-12 20:36
大神如何换向呢

网络程序，感谢作者，多段线反向

(defun c:fan( / A B C D ENT LST LST1 TMP)
        (SETQ EN (CAR (ENTSEL)))               
(setq ENT (entget EN))
(setq tmp ent)
(while (setq tmp (member (assoc 10 tmp) tmp))
    (setq a   (assoc 10 tmp)
          b   (cons 40 (cdr (assoc 41 tmp)))
          c   (cons 41 (cdr (assoc 40 tmp)))
          d   (cons 42 (- (cdr (assoc 42 tmp))))
          LST (append (list b c d a) LST)
    ) ;_ 结束setq
    (setq tmp (cddddr tmp))
) ;_ 结束while
(repeat 3 (setq LST (append (cdr lst) (list (car lst)))))
(setq lst1 (reverse (cdr (member (assoc 10 ent) (reverse ent)))))
(entmod (append lst1 lst '((210 0 0 1))))
) ;_ 结束defun

13648893846 发表于 2017-10-21 20:00:56

lzj511 发表于 2017-10-19 22:49
网络程序，感谢作者，多段线反向

(defun c:fan( / A B C D ENT LST LST1 TMP)


多谢大神,不过我是问的楼主接着画的程序能否换向,

wzg356 发表于 2020-10-17 13:04:51

13648893846 发表于 2017-10-21 20:00
多谢大神,不过我是问的楼主接着画的程序能否换向,

点击的前半段 后半段

13648893846 发表于 2017-10-12 20:36:24

大神如何换向呢

pxt2001 发表于 2017-10-14 23:10:42

希望楼主的程序，能支持ucs，能支持u回退。

fsafaffa 发表于 2017-10-15 14:32:02

顶顶顶顶顶顶顶

pengfei2010 发表于 2017-10-16 08:55:25

回帖是一种美德！感谢楼主的无私分享 谢谢

水仙的错 发表于 2017-10-19 16:56:47

为什么接着画就变成直线了？如果还是弧线顺过去就好了

004 发表于 2018-6-13 22:03:40

测绘，地形图编辑常用的功能！

sws 发表于 2020-7-28 21:31:16

多谢大神多谢大神
页: [1] 2
查看完整版本: 多义线线头或线尾加点（多段线接着画）