谁改改直线批量合并的问题啊，改成框选合并
本帖最后由 xj6019 于 2019-11-23 21:10 编辑看到 别人求助的 好几年了，也没高手改，下面的代码是单条直线合并的，谁帮忙改成框选合并直线啊，这样改改应该很方便作图啊
以下是代码 期盼高手出现啊
最好能实现图片的 情况的连接 同一方向和有拐角的情况 这两种情况能实现就太完美了，期待能等到哦
(defun C:2IN1 (/ VLINE1 VLINE2 DL1DL2 PT1 PT2 PT3 PT4 PT_LIST DIST DIST1 N NN ENT ANG1 ANG2ANG3 ANG4) (defun GETLINE (MSG / A1) (INITGET 1) (setq A1 (car (entsel MSG))) (while (/= (cdr (assoc 0 (entget A1))) "LINE")(PRINC "\n您选的不是线图元,请再选一次...")(INITGET 1)(setq A1 (car (entsel MSG))) ) A1 ) (PRINC "\n请选取二条断线来接合....") (setq VLINE1 (GETLINE "\n请选取第一条线: ")) (while (or (= VLINE2 nil) (equal VLINE1VLINE2)) (if (equal VLINE1 VLINE2) (PRINC "\n线重复,请再选一次...")) (setq VLINE2 (GETLINE "\n请选取第二条线: ")) ) (SETQ DL1 (ENTGET VLINE1) DL2 (ENTGET VLINE2) PT1 (cdr (assoc 10 DL1))PT2 (cdr (assoc 11 DL1)) PT3 (cdr (assoc 10 DL2))PT4 (cdr (assoc 11 DL2)) ANG1 (angle PT1 PT2) ANG2 (angle PT4 PT3) ANG3 (+ PI ANG1) ANG4 (+ ANG2 PI)) (if (or (equal ANG1 ANG2 1e-9) (equal ANG1ANG4 1e-9) (equal ANG3 ANG2 1e-9) (equal ANG3ANG4 1e-9) ) (progn (setq PT_LIST (list PT1 PT2 PT3 PT4) DIST (distance PT1 PT2)N 0) (repeat 3(setq NN 1)(repeat 3 (if (> (setq DIST1 (distance (nth N PT_LIST) (nth NN PT_LIST))) DIST) (setq DIST DIST1PT1 (nth N PT_LIST)PT2 (nth NN PT_LIST)) ) (setq NN (1+ NN)))(setq N (1+ N)) ) (setq DL1 (subst (cons 10 PT1) (assoc 10 DL1) DL1) DL1 (subst (cons 11 PT2) (assoc 11 DL1)DL1)) (entmod DL1) (entdel VLINE2) ) (COMMAND "FILLET" "R" "0""FILLET" VLINE1 VLINE2) ) (PRINC))(PRINC)
框选倒角很难实现,很难判断哪个跟哪个倒角.
之前写了一个自己用的插件,没有考虑通用性.也没考虑太多的错误处理
有两个限制,一个是只能用于直线,不能用于多段线.
另一个是两组直线应该是两组平行线,如果两组之间不平行,没办法确定倒角的顺序.
当然,如果把框选的要求降级为栏选,,就排序和获取选择点两个问题就能轻易解决了.
(defun c:ttt ( /*acad* *doc* FILLETRAD FILLETRAD_ls ss lst_ssall lst_line1 lst_line2 lst_line1px lst_line2px line1_xs line2_xs en_line1 en_line2 i pt1 pt2
wyl:ss2ptlist wyl:ssjdfz wyl:dxf wyl:pass wyl:dyjhb wyl:ptlinecd wyl:ptlincdpx
)
;|
说明:传入一个选择集,按照图元的角度分成两组
参数:ss,选择集
返回值:两组图元名的列表((图元名)(图元名))
|;
;(setq en_line1 lst_line1)
(defun wyl:ssjdfz(ss / lst_ss lst_line1 ang ang2 )
(setq lst_ss (wyl:ss2ptlist ss -1) )
(setq lst_line1 (nth 0 lst_ss)
lst_ss (vl-remove lst_line1 lst_ss)
)
(ssdel lst_line1 ss);ssdel直接操作选择集,不需要重新赋值
(setq ang (angle (cdr (wyl:dxf 10lst_line1)) (cdr (wyl:dxf 11lst_line1)) ))
(if (>= ang (angtof "180") )
(setq ang (- ang (angtof "180")))
)
(setq lst_line1 (list lst_line1))
;(setq x (nth 3 lst_ss))
(foreach x lst_ss
(setq ang2 (angle (cdr (wyl:dxf 10 x))(cdr (wyl:dxf 11 x)) ))
(if (>= ang2 (angtof "180") )
(setq ang2 (- ang2 (angtof "180")))
)
(if (equal ang ang2 0.01)
(progn
(setq lst_line1 (cons x lst_line1))
(ssdel x ss);如果这条线角度和前面的相同,那么加入到lst_line1中,并且从ss中删除
)
)
)
(list lst_line1 (wyl:ss2ptlist ss -1))
)
;;选择集转为dxf列表
;;说明:传入选择集,将对应的组码返回
;;参数:ss:选择集
;;参数:dxf:组码,例如10代表插入点,0代表对象类型,2代表对象名,8代表图层,-1是图元名
;;返回:列表
(defun wyl:ss2ptlist ( ss dxf / n i elist )
;(defun ss2ptlist ( ss / )
(setq n (if (= (type ss) 'Pickset) (sslength ss) 0)
elist '()
)
(repeat n
(setq elist (cons(cdr (assoc dxf(entget (ssname ss (setq n (1- n))))))elist))
)
)
;|
dxf,根据组码编号及对象返回组码内容
参数：
i：编号，int
en：对象图元名或对象信息表，ename或list
返回值：对应子表包含组码值，如果错误返回对应内容,如果传入的en为nil那么返回(nil nil)
|;
(defun wyl:dxf(i en / r)
;(defun wyl:dxf(i en / )
(if en
(progn
(setq r nil)
(if (/= "INT" (vl-prin1-to-string (type i)))
(setq r "确定组码为int")
)
(if (and (/= "ENAME" (vl-prin1-to-string(type en)))
(/= "LIST" (vl-prin1-to-string(type en))))
(setq r "确定en为表或者ename")
)
; (if (= "LIST" (type en))
; (if (/= -1 (caar en))
; (print "en错误，首个子表不为-1")
;
; )
; )
(if (and
(not r)
(= "LIST" (vl-prin1-to-string(type en)))
)
(if (/= nil (assoc i en))
(setq r (assoc i en))
(setq r "无对应组码")
)
(setq r (wyl:dxf i (entget en)))
)
r
)
;(print "传入的en为nil");这里为什么没有输出?
'(nil nil)
)
)
(defun wyl:pass( /)
nil
)
;|
说明:给两个直线的图元名和两个点,倒圆角并合并成多段线,如果点不在直线上,先把直线延长
参数:pt:点
en_line:直线的图元名
返回值:无
|;
(defun wyl:dyjhb (pt1 pt2 en_line1 en_line2 / en_last)
(if (equal pt1 (vlax-curve-getclosestpointto (vlax-ename->vla-object en_line1) pt1) 1e-6)
(wyl:pass)
(progn
(if (< (distance pt1 (cdr (wyl:dxf 10 en_line1)))
(distance pt1 (cdr (wyl:dxf 11 en_line1)))
)
(setq ed_line1 (subst (cons 10 pt1) (wyl:dxf 10 en_line1) (entget en_line1) ))
(setq ed_line1 (subst (cons 11 pt1) (wyl:dxf 11 en_line1) (entget en_line1)))
)
(entmod ed_line1)
)
)
(if (equal pt2 (vlax-curve-getclosestpointto (vlax-ename->vla-object en_line2) pt2) 1e-6)
(wyl:pass)
(progn
(if (< (distance pt2 (cdr (wyl:dxf 10 en_line2)))
(distance pt2 (cdr (wyl:dxf 11 en_line2)))
)
(setq ed_line2 (subst (cons 10 pt2) (wyl:dxf 10 en_line2) (entget en_line2)))
(setq ed_line2 (subst (cons 11 pt2) (wyl:dxf 11 en_line2) (entget en_line2)))
)
(entmod ed_line2)
)
)
(command "FILLET" pt1 pt2)
(setq en_last (entlast))
;(setq ss1 (ssadd en_last ))
; (ssadd en_line1 ss1 )
;(ssadd en_line2 ss1 )
;(command "PEDIT" "M" ss1 "" "Y" "J" "" "");选择集后面需要加空格,应该是因为可以多次选择的原因吧?
(command "PEDIT" "M" en_last en_line1 en_line2 "" "Y" "J" "" "")
)
;|
说明:给点一个点和一条直线,获取垂点后返回
参数:pt:点
en_line:直线图元名
返回值:(垂点 垂线长度 图元名)
|;
(defun wyl:ptlinecd(pt en_line /cd cxcd )
(if (= 'ENAME (type en_line))
(setq cxcd (distance
(setq cd (vlax-curve-getClosestPointTo (vlax-ename->vla-object en_line) pt t)) pt))
(exit)
)
(list cd cxcd en_line)
)
;|
说明:给点一个点和一组直线,将根据垂线长度排序后返回
参数:pt:点
lst_line:直线图元列表
返回值:
|;
(defun wyl:ptlincdpx(pt lst_line / lst_linepx )
(setq lst_linepx '(nil))
;(setq lst_line lst_line1)
;(setq x (nth 0 lst_line))
(foreach x lst_line
(setq lst_linepx (cons (wyl:ptlinecd pt x) lst_linepx))
)
(setq lst_linepx (vl-remove nil lst_linepx))
(setq lst_linepx (vl-sort lst_linepx '(lambda (x y) (< (cadr x)(cadr y)) ) ))
)
(vl-load-com)
(setq *acad* (vlax-get-acad-object))
(setq *doc* (vla-get-ActiveDocument *acad*))
(setvar "cmdecho" 0)
(command "_undo" "be")
(setq oldOSMODE (getvar "OSMODE"))
;(setq old_error *error*)
;(setq *error* wyl:err)
(setvar "OSMODE" 0)
(setq FILLETRAD (getvar "FILLETRAD") )
(if (setq FILLETRAD_ls (getint (strcat "\n输入倒角半径,默认为:" (vl-princ-to-string FILLETRAD))))
(setq FILLETRAD FILLETRAD_ls)
)
(setvar "FILLETRAD" FILLETRAD)
(princ "\n选择需要倒角的直线:")
(setq ss (ssget '((0 . "LINE"))))
(setq lst_ssall (wyl:ssjdfz ss))
(setq lst_line1 (car lst_ssall)
lst_line2 (cadr lst_ssall)
);获得了两组直线列表
(setq ptf (getpoint "\n选择倒角内的一点:"))
(setq lst_line1px (wyl:ptlincdpx ptf lst_line1))
(setq lst_line2px (wyl:ptlincdpx ptf lst_line2))
(setq i 0)
(repeat (min (length lst_line1px) (length lst_line2px))
(setq line1_xs (nth i lst_line1px)
line2_xs (nth i lst_line2px)
)
(setq pt1 (car line1_xs)
pt2 (car line2_xs)
en_line1 (caddr line1_xs)
en_line2 (caddr line2_xs)
)
(wyl:dyjhb pt1 pt2 en_line1 en_line2)
(setq i (1+ i))
)
(setvar "OSMODE" oldOSMODE)
(command "_undo" "e")
(setvar "cmdecho" 1)
;(setq *error* old_error)
(setq *acad* nil *doc* nil)
)
(princ)
本帖最后由 xj6019 于 2019-11-24 19:52 编辑
我用过别的软件 不知道代码是啥 左键框选是相交合并 右键框选是框选删除可得劲了一直希望cad能实现这样的效果 本帖最后由 panliang9 于 2019-11-25 09:03 编辑
http://bbs.mjtd.com/forum.php?mo ... %B5%B9%BD%C7&page=1
上面是拐角本版的讨论。
下面是join命令的改进，搬运的。
attach://106270.lsp 下面是join命令的改进，搬运的。
http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTA2MjcwfGVjNzI4Mjk0ZmZmZDAzOGNmMTAxYTk1ZGQ4ODc0ZTA2fDE1NzQ2NTY4MjY%3D&request=yes&_f=.lsp
支持多段线(0 . "line,arc,spline,ellipse,polyline,lwpolyline")
但多段线好像不能合并 cqf1980 发表于 2019-11-25 12:43
下面是join命令的改进，搬运的。
http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTA2MjcwfGVjNzI4Mjk ...
应该是jion本身不支持多线 cqf1980 发表于 2019-11-25 17:53
应该是jion本身不支持多线
不行不能用 目前我看到的比较好的就是源泉的一个功能还可以lisp目前没发现可以用的 xj6019 发表于 2019-11-24 19:03
我用过别的软件 不知道代码是啥 左键框选是相交合并 右键框选是框选删除可得劲了一直希望cad能实现 ...
这是源泉的什么命令？ longer1000 发表于 2019-11-25 20:17
这是源泉的什么命令？
我看快捷键好像是FX，我电脑上没有源泉我也不是很确定哦 xj6019 发表于 2019-11-26 08:37
我看快捷键好像是FX，我电脑上没有源泉我也不是很确定哦
哦，那估计你用的别的插件吧。感谢
页:
[1]