pedit 操作polyline
本帖最后由 wzg356 于 2020-10-12 12:01 编辑"Lwpolyline"加删点继续画等程序比较多了，本论坛随便搜
关于polyline加删点、继续画等功能，难度高，本人纯lisp写还无法逾越
改用(command "pedit".......)配合,成了，还以为polyline、Lwpolyline都可以通用
突然发现
(command "pedit"..编辑顶点......拉直....)及（command "pedit".编辑顶点...插入....)后
"AcDb3dpolyline"的线（我简单用3dpoly画的）没事
"AcDb2dpolyline" 的线（cass画的宗地图）图元名、句柄没变，(0 . "polyline")却变成了(0 . "Lwpolyline")
polyline变成了Lwpolyline有点严重了
没心肠继续了
程序在下面已完成的可以用，只是上面的问题没解决
有高手出点意见为谢！！！！！
----------------------
说明一下，程序中获取多线段的子段或顶点索引已改用几何法
结果与(vlax-curve-getparamatpoint obj pp)法类似，二维操作更严密
个别没使用的函数也放在里面，有用到的拿去参考
20201012已更新
本帖最后由 wzg356 于 2020-10-12 14:37 编辑
;多段线顶点数量
;;示例 (GetCurveptNum (car (entsel)))
(defun GetCurveptNum (obj)
(if (vlax-curve-isClosed obj)
(fix (vlax-curve-getendParam obj))
(1+ (fix (vlax-curve-getendParam obj)))
)
)
;[功能] pline,lwpline点坐标表By 无痕
;;选直线时坐标会很多很多
;真假封闭多线段坐标数量不同
;;示例(GetCurvepts (car (entsel))),返回二(三)维点坐标
(defun GetCurvepts (e / i v lst)
(setq i -1)
(while(setq v(vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons (list (car v)(cadr v)) lst))
;(setq lst (cons v lst))
)
(reverse lst)
)
;判断点在多线段上位置
;返回nil或点在线上位置;
;类似(vlax-curve-getparamatpoint obj pp)的结果，更准确
;(isptonpline (GetCurvepts(car (setq en(entsel))))(cadr en) 0.05)
(defun isptonpline (pts pt fz / isptonpline loop nn l)
(defun IsPtOnLine (pt l1 l2 fz)
(equal (+ (distance l1 pt) (distance l2 pt))
(distance l1 l2) fz
)
)
(setq loop nil nn 0)
(while(and (not loop)(> (length pts)1))
(if (setq loop(IsPtOnLine pt (car pts)(cadr pts) fz))
(progn (setq l (distance (car pts)(cadr pts)))
(if (and(< (distance pt (car pts)) l)(< (distance pt (cadr pts)) l))
(setq loop(+ nn(/(distance pt (car pts))l)))
(setq loop nn)
);防止0长度线出错
)
)
(setq pts (cdr pts))(setq nn (1+ nn))
)
loop
)
;根据线上位置获得pline,lwpline顶点索引（起始端为0）
;;示例(Pickpl2numPt (car(setq en(entsel))) (cadr en))
(defun Pickpl2numPt (en p / num )
(setq num(GetCurveptNum en))
(setq n(fix (+ 0.5(isptonpline (GetCurvepts en) p 0.05))))
(if (= n num)0 n)
)
;根据线上位置获得pline,lwpline子段索引（起始段为0）
;;示例(Pickpl2numl (car(setq en(entsel))) (cadr en))
(defun Pickpl2numl (en p / )
(fix (isptonpline (GetCurvepts en) p 0.05))
)
;[功能] 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 DelCurveEndpt1 (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 DelCurveEndpt (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)
(repeatindex(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指定下一点:"))
)
(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) (setq endpt (trans(vlax-curve-getEndPoint OBJ)0 1));终点
)
((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)
)
谢谢分享，非常好用 提两个使用上的问题：1、pljx只能从结束点开始加线，最好能修改成选取段最近端点开始加线，实用性将大大增强。2、pljd和plsd在多次使用后无法识别清楚拾取段（点），反而在别的位置加点了。 cghdy 发表于 2020-10-12 10:05
提两个使用上的问题：1、pljx只能从结束点开始加线，最好能修改成选取段最近端点开始加线，实用性将大大增 ...
1继续画一般从起点或终点开始就行了
中间加点也是连续循环的，可以在不同子段，不同图元之间连续进行，不必改了
2 子段端点识别问题，改为纯几何法算
已更新 wzg356 发表于 2020-10-12 11:33
1继续画一般从起点或终点开始就行了
中间加点也是连续循环的，可以在不同子段，不同图元之间连续进行， ...
非常感谢，但是对于第一点我还是保留我的意见 wzg356 发表于 2020-10-12 11:33
1继续画一般从起点或终点开始就行了
中间加点也是连续循环的，可以在不同子段，不同图元之间连续进行， ...
你好，更新后程序无法正常使用，下面两个函数会出错。
;根据线上位置获得pline,lwpline顶点索引（起始端为0）
;;示例(Pickpl2numPt (car(setq en(entsel))) (cadr en))
(defun Pickpl2numPt (en p / num )
(setq num(GetCurveptNum en))
(setq n(fix (+ 0.5 (isptonpline (GetCurvepts en) p 0.05))))
(if (= n num)0 n)
)
;根据线上位置获得pline,lwpline子段索引（起始段为0）
;;示例(Pickpl2numl (car(setq en(entsel))) (cadr en))
(defun Pickpl2numl (en p / )
(fix (isptonpline (GetCurvepts en) p 0.05))
)
页:
[1]