多线段继续lsp

wzg

;wzg 修改于20150417
(defun c:pljx  ( / ss en enl ContinuePL oldce)
;;<a href=\"http://bbs.mjtd.com/thread-107695-2-1.html\"
;;by edata
(defun ContinuePL (en / obj end_pt pt c_flag n ch_start ch_close ch_open )
  (vl-load-com)
  (if en
    (progn      
      (setq obj (vlax-ename->vla-object en)
            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" )));永远返回t
                  (setq pt (getpoint end_pt "\n指定下一点[S从起点开始/E从终点开始/C闭合/O打开]:"))
             )
        (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
             )
             (setq n (fix (vlax-curve-getendParam obj))
                   c_flag nil
             )
           )
           (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))
                 )
               )
               (setq end_pt (trans(vlax-curve-getStartPoint OBJ)0 1))
             )
             (progn
               (vla-addvertex  obj (1+ n)
                 (vlax-safearray-fill
                   (vlax-make-safearray vlax-vbDouble '(0 . 1))
                   (list (car pt) (cadr pt))
                 )
               )
               (setq end_pt (trans(vlax-curve-getEndPoint OBJ)0 1))
             )
           )
          )
          ((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)           
           )
        )
      )
    )
  )
)
;-----------------------
;(while (not(setq ss (ssget ":E:S" '((0 . "*OLYLINE"))))))
;(setq en (ssname ss 0))
(setvar "cmdecho" 0)
(princ "\n功能:多线段或直线继续画,直线则转为多线段")
(initget "  ")
(setq en (entsel "\n点击多线段或直线继续画..."))
(cond
        ((= en "")nil)
        ((and (setq en (car en))
              (setq enl (entget en))
                (member (cdr(assoc 0 enl))(list "POLYLINE" "LWPOLYLINE" "LINE"))
        )
        (cond
                ((and(wcmatch(cdr(assoc 0 enl))"POLYLINE")
                (= (cdr(assoc 70 enl)) 4)
                (or (= (cdr(assoc 75 enl)) 5) (= (cdr(assoc 75 enl)) 6))
                )
                (command "pedit" en "d" "")
                (ContinuePL en)
                (command "pedit" en "s" "")
                (setvar "cmdecho" 1)
                )
                ((and (wcmatch(cdr(assoc 0 enl))"POLYLINE")               
                (= (cdr(assoc 70 enl)) 2)
                (= (cdr(assoc 75 enl)) 0)
                )
                (command "pedit" en "d" "")
                (ContinuePL en)
                (command "pedit" en "f" "")
                (setvar "cmdecho" 1)
                )
                ((wcmatch(cdr(assoc 0 (entget en)))"LWPOLYLINE")
                        (ContinuePL en)
                )
                ((wcmatch(cdr(assoc 0 (entget en)))"LINE")
                        (setq oldce (getvar "PEDITACCEPT"))
                         (setvar "PEDITACCEPT" 1)
                         (command "pedit" en "W" "0" "")
                         (setvar "PEDITACCEPT" oldce)
                         (setvar "cmdecho" 1)
                         (setq en (entlast))
                        (ContinuePL en)
                )
        ))
        (t (c:pljx))
)
(princ)
)       

对方水电费的

真是6啊！！！

suihan001

过来学习学习，查漏补缺一下