麻烦谁可以帮我把这个插件末尾增加一个合并线段的功能啊！！感谢
(princ "\n Loading lp.lsp ...")(defun c:lp( / ssf1 ssf2 ssf3 ssf4 ssf5 ssf6 p1 p2 pcen rad
p3 oldwid ww ww1 wid1 ltt clt cor cclor
d1 d2 p1 p2 p3 p4 ara rad p33 p34
ssff ssff0 ssff1 ssff2 ssff3 ssff4 ssff5
ssla ele1 ele2 en0
)
(setqww nil ww1 nil)
(setq #pi90 (* pi 0.50) ;half of pi
#pi180 (* pi 1.00) ;pi
#pi270 (* pi 1.50) ;1-1/2 of pi
);setq ;*
(setvar "cmdecho" 0)
(setvar "highlight" 1)
(command "units" "2" "4" "1" "4" "0" "n")
(command "ucs" "world")
(princ "\nLinetype to Polyline, Version 2.20 (C)1996-2000 by ECEC,Inc")
(setq ssf1 (ssget))
(if ssf1
(progn
(setq wid1 (getvar "PLINEWID"))
(princ "\nµ±Ç°¶àÒåÏßĬÈÏ¿í¶ÈΪ") (princ wid1)(princ "mm")
(initget0 )
(princ "\nÇëÊäÈëÐ޸ĺóµÄÏß¿í" )
(princ "< ") (princ wid1) (princ " mm>:")
(setq wid (getreal " " ))
(if wid
(princ)
(setq wid wid1)
);if
(setvar "plinewid" wid)
(setq ssf2 (sslength ssf1))
(setq ssf3 0)
(while (<= ssf3 (- ssf2 1))
(setq ssf4 (ssname ssf1 ssf3))
(setq ssf5 (entget ssf4))
(cond
((= (dxf 0 ssf5) "CIRCLE")
(redraw ssf4 3)
(setq pcen (dxf 10 ssf5))
(setq rad (dxf 40 ssf5))
(setq p1 (polar pcen #pi270 rad))
(setq p2 (polar pcen #pi90rad))
(entdel ssf4)
(command "osnap" "none")
(command "pline" p1 "w" wid wid "arc" "CE" pcen p2 p1 "")
(setq ssla (entget (entlast)))
(if (dxf 6 ssf5)
(command "change" (dxf -1 ssla) "" "P" "LT" (dxf 6 ssf5) "")
);if
(setq ssla (entget (entlast)))
(if (dxf 62 ssf5)
(command "change" (dxf -1 ssla) "" "P" "Color" (dxf 62 ssf5) "")
);if
(setq ssla (entget (entlast)))
(if (dxf 39 ssf5)
(command "change" (dxf -1 ssla) "" "P" "Elev" (dxf 39 ssf5) "")
);if
(setq ssla (entget (entlast)))
(if (dxf 8 ssf5)
(command "change" (dxf -1 ssla) "" "P" "LA" (dxf 8 ssf5) "")
);if
(setq ssf4 (entget (entlast)))
(redraw (dxf -1 ssf4))
);cond2
((= (dxf 0 ssf5) "ARC")
(redraw ssf4 3)
(command "pedit"(dxf -1 ssf5) "Y" "W" wid "X")
(setq ssf4 (entget (entlast)))
(redraw (dxf -1 ssf4))
);cond
((= (dxf 0 ssf5) "POLYLINE")
(redraw ssf4 3)
(command "osnap" "none")
(if (or (= (dxf 70 ssf5) 0) (= (dxf 70 ssf5) 1))
(progn
(command "pedit" (dxf -1 ssf5) "w" wid "X")
);progn
(progn
(setq ssf5 (subst (cons 70 0) (assoc 70 ssf5) ssf5))
(entmod ssf5)
(entupd (dxf -1 ssf5))
(command "pedit" (dxf -1 ssf5) "w" wid "X")
);progn
);if
);cond PLINE
((= (dxf 0 ssf5) "LWPOLYLINE")
(redraw ssf4 3)
(command "osnap" "none")
(if (or (= (dxf 70 ssf5) 0) (= (dxf 70 ssf5) 1))
(progn
(command "pedit" (dxf -1 ssf5) "w" wid "X")
);progn
(progn
(setq ssf5 (subst (cons 70 0) (assoc 70 ssf5) ssf5))
(entmod ssf5)
(entupd (dxf -1 ssf5))
(command "pedit" (dxf -1 ssf5) "w" wid "X")
);progn
);if
);cond LWPLINE
((= (dxf 0 ssf5) "LINE")
(redraw ssf4 3)
(setq ele1 (caddr (dxf 10 ssf5))
ele2 (caddr (dxf 11 ssf5))
)
(if (>= (abs (- ele1 ele2)) 0.0001)
(progn
(setq en0 (subst (cons 10 (list (car (dxf 10 ssf5))
(cadr (dxf 10 ssf5))
ele1))
(cons 10 (dxf 10 ssf5))
ssf5
)
);setq
(entmod en0)
(setq ssf5 (entget (entlast)))
(setq en0 (subst(cons 11 (list (car (dxf 11 ssf5))
(cadr (dxf 11 ssf5))
ele1))
(cons 11 (dxf 11 ssf5))
ssf5
)
);setq
(entmod en0)
(setq ssf5 (entget (entlast)))
);progn
);if
(command "osnap" "none")
(command "pedit" (dxf -1 ssf5) "Y" "w" wid "X")
);cond PLINE
(T
(redraw ssf4 3)
(princ "\nʵÌåΪ") (princ (dxf 0 ssf5)) (princ "ÀàÐÍ,²»Ðèת»»Îª¶àÒåÏß !")
);default
);cond
(setq ssf3 (1+ ssf3))
);while
(redraw)
);progn ssf1
(princ)
);if
(command "units" "2" "4" "1" "4" "0" "n")
(princ)
);end of defun
(defundxf ( hgg hgg1 / )
(cdr (assoc hgg hgg1 ))
);defun
(defun div-pt (p1 p2 inc / m)
(setq m (mapcar '+ p1 (mapcar '* (list inc inc inc) p2)))
(mapcar '/ m
(list (+ 1 inc) (+ inc 1) (+ inc 1)))
);defun
(princ " loaded.")
(princ "\n Now you can start command with LP.")
(princ)
本帖最后由 YuHB 于 2024-6-15 14:06 编辑
应该就用 (command "pedit" "m")命令就可以实现，这个命令你贴出来的代码里面就用过。
一般大神估计不愿意回复你这种问题的，我也不太懂autolisp，所以只是抱着试试的心态。
不过可能我理解得不对，不一定是你想要的效果啊。
;;;
(setq e0 (entlast));;这一句加在主程序开头
...........;;省略处是你程序的主要内容
(setq ss (MyEntNext e0 ssf1));;这两句加在主程序末尾，0.005是我随便设的容差，自己调整
(command "pedit" "m" ss "" "j" 0.005 "");;
;;后面是一个子程序（由黄明儒分享的函数修改）
(defun MyEntNext (en ss / )
(if (= (type ss) 'pickset) nil (setq ss (ssadd)))
(if en
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND"))) (ssadd en ss))
)
)
ss
)
页:
[1]