pedit 操作polyline 问题

wzg35356

关于polyline加删点、继续画等功能，难度高，本人纯lisp写还无法逾越

改用(command "pedit".......)配合,成了，还以为polyline、Lwpolyline都可以通用

突然发现

(command "pedit"..编辑顶点......拉直....)及（command "pedit".编辑顶点...插入....)后

"AcDb3dpolyline"的线（我简单用3dpoly画的）没事

"AcDb2dpolyline" 的线（cass画的宗地图）图元名、句柄没变，(0 . "polyline")却变成了(0 . "Lwpolyline")


polyline变成了Lwpolyline有点严重了
没心肠继续了

程序在下面
已完成的可以用，只是上面的问题没解决
有高手出点意见为谢！！！！！

wzg35356

;多段线顶点数量
;;示例 (GetCurveptNum (car (entsel)))
(defun GetCurveptNum (obj)
  (if (vlax-curve-isClosed obj)
    (fix (vlax-curve-getendParam obj))
    (1+ (fix (vlax-curve-getendParam obj)))
  )
)
;根据线上位置获得pline,lwpline顶点索引（起始端为0）
;;示例(Pickpl2numPt (car(setq en(entsel))) (cadr en))
(defun Pickpl2numPt (obj p / pp num n)
        (setq num(GetCurveptNum obj))
        (setq pp(vlax-curve-getClosestPointTo  obj (trans p 1 0)))       
        (setq n(fix (+ 0.5(vlax-curve-getparamatpoint obj pp))))
        (if (= n num)0 n)
)
;根据线上位置获得pline,lwpline子段索引（起始端为0）
;;示例(Pickpl2numPt (car(setq en(entsel))) (cadr en))
(defun Pickpl2numl (obj p / pp)
        (setq pp(vlax-curve-getClosestPointTo  obj (trans p 1 0)))       
        (fix (vlax-curve-getparamatpoint obj pp))
)

;[功能] pline,lwpline假闭合
;;示例(CurveLikeClosed (car (entsel)) 0.01)
(defun LikeClosed (e fz)
  (and (not(vlax-curve-isClosed e))
           (equal (vlax-curve-getStartPoint e)
                      (vlax-curve-getEndPoint e)
                      fz
      )
  )
)
;[功能] pline,lwpline删终点
;;示例(DelCurveEndpt1 (car (entsel)))
(defun DelCurveEndpt (en / num ns)
        (setq num(GetCurveptNum en))
        (if(> (setq num(GetCurveptNum en))2);顶点数
                (progn
                        (repeat  (- num 2)(setq ns(cons "n" ns)))
                        (eval(append
                                    (list 'command "_pedit" 'en "e")
                                    (append ns(list "b" "g" "x" ""))
                                )
                        );打断
                        (entdel(entlast))
                )
        )
);打断法---优点这是真删
(defun DelCurveEndpt1 (en / num pt ns)
        (if(> (setq num(GetCurveptNum en))2);顶点数
                (progn
                        (setq pt(vlax-curve-getPointAtParam en (- num 2)));前一点坐标
                        (repeat  (- num 3)(setq ns(cons "n" ns)))
                        (eval(append(list 'command "_pedit" 'en "e")
                                                (append ns(list "s" "n" "n""g" "x" ""))
                        ));拉直-删除前一点
                        (setq ns(cons "n" ns))
                        (eval(append(list 'command "_pedit" 'en "e")
                                                (append ns(list "m" "non" 'pt "x" ""))
                        ));移动端点到前一点
                )               
        )
);移动法----缺点这是假删

;[功能] pline,lwpline删起点
;;示例(DelCurveStartpt (car (entsel)))
;移动法，打断法不可取
(defun DelCurveStartpt (en / num pt)
        (if(> (setq num(GetCurveptNum en))2);顶点数
                (progn
                        (setq pt(vlax-curve-getPointAtParam en 1)); 第二点坐标
                        (eval(append(list 'command "_pedit" 'en "e")
                                                (list "s" "n" "n""g" "x" "")
                        ));拉直-删除第二点
                        (eval(append(list 'command "_pedit" 'en "e")
                                                (list "m" "non" 'pt "x" "")
                        ));移动端点到前一点
                )               
        )
)

;[功能] pline,lwpline 按顶点索引删点
;index起点为0
;;示例(DelCurvept (car (entsel)) 1)
(defun DelCurvept (en index / num pt ns)
        (if(> (setq num(GetCurveptNum en))2);顶点数
                (cond
                        ((and (> index 0) (< index (- num 1)))
                            (repeat (1- index)(setq ns(cons "n" ns)))
                            (eval(append(list 'command "_pedit" 'en "e")
                                                (append ns(list "s" "n" "n""g" "x" ""))
                                ));拉直-删除                               
                        )
                        ((= index 0)(DelCurveStartpt en))
                        ((= index (- num 1))(DelCurveEndpt en))
                        (t nil)
                )
        );
)
;[功能] pline,lwpline 按子段索引加点
;index起点为0
(defun AddCurvept (en index pt / ns)
        (repeat  index(setq ns(cons "n" ns)))
        (eval(append(list 'command "_pedit" 'en "e")
                                (append ns(list "i" 'pt "x" ""))
        ))
)
;[功能] pline,lwpline 继续画1点
;tt为nil则从起点开始
(defun ContinuePL (en pt tt / num pt0)
        (setq num (GetCurveptNum en));顶点数
        (if tt(AddCurvept en (1- num) pt);终端加点
                (progn
                        (setq pt0(vlax-curve-getPointAtParam en 0));起点坐标
                        (eval(append(list 'command "_pedit" 'en "e")
                                                (list "m" "non" 'pt "x" "")
                        ));移动起点
                        (AddCurvept en 0 pt0);第1子段加点                       
                )
        )       
)
;程序1
;pline,lwpline 删顶点
(defun c:plsd ( / en ent)
(setvar "cmdecho" 0)
(initget "  ")
(setq en (entsel "\n点击要删除的多线段顶点..."))
(cond
        ((= en "")nil)
        ((and (setq ent (car en))
                        (wcmatch(cdr(assoc 0(entget ent)))"*POLYLINE")
                )
                (DelCurvept ent (Pickpl2numPt ent (cadr en)))
                 (c:plsd)
        )
        (t (c:plsd))       
)
(setvar "cmdecho" 1)
(princ)
)
;程序2
;pline,lwpline 加点
(defun c:pljd ( / en ent)
(setvar "cmdecho" 0)
(initget "  ")
(setq en (entsel "\n点击多线段子段..."))
(cond
        ((= en "")nil)
        (        (and (setq ent (car en))
                        (wcmatch(cdr(assoc 0(entget ent)))"*POLYLINE")
                )
                (princ "\n指定加点位置")               
                (AddCurvept ent (Pickpl2numl ent (cadr en)) (getpoint))
                 (c:pljd)
        )
        (t (c:pljd))       
)
(setvar "cmdecho" 1)
(princ)
)

;程序3
;pline,lwpline继续画
(defun c:pljx ( / en obj seflag cflag endpt okflag pt)
(initget "  ")
(setq en (entsel "\n选择多线段..."))
(cond
        ((= en "")nil)
        ((and (setq en (car en))
                        (wcmatch(cdr(assoc 0(entget en)))"*POLYLINE")
                        (setq obj (vlax-ename->vla-object en))                               
                )
                (setq seflag t);默认从末端开始画
                (setq cflag (if(vlax-curve-isClosed obj)1 0));闭合情况
                (setq obj (vlax-ename->vla-object en))
                (and (= cflag 1) (vla-put-closed obj 0));闭合则打开
                (setq endpt (trans(vlax-curve-getEndPoint OBJ)0 1));终点
                (setq okflag nil);结束标志
                (setvar "cmdecho" 0)               
                (while(and(not okflag)
                              (car (list t (initget "S E C  " )));永远返回t
                  (setq pt (getpoint endpt "\n指定下一点[S起点开始/E终点开始/C闭合]:"))
            )            
            (cond
                    ((= (type pt) 'list)
                            (ContinuePL en pt seflag)
                            (if seflag
                                    (setq endpt (trans(vlax-curve-getEndPoint OBJ)0 1));终点
                                    (setq endpt (trans(vlax-curve-getStartPoint OBJ)0 1));起点
                            )
                    )
                    ((and (= (type pt) 'str)(= pt "S"))
                            (setq seflag nil)
                            (setq endpt (trans(vlax-curve-getStartPoint OBJ)0 1))
                    )
                    ((and (= (type pt) 'str)(= pt "E"))
                            (setq seflag t)
                    )
                    ((and (= (type pt) 'str)(= pt "C"));闭合就结束
                            (setq cflag 1)
                            (setq okflag t)
                    )
                    (t (setq okflag t))
            )            
        )
        (vla-put-closed obj cflag);恢复闭合状态
        (setvar "cmdecho" 1)
        )       
)
(princ)
)