一次框选把内部四个交点连线剪掉
大家好，如何实现一次框选把内部四个交点连线剪掉(defun C:T4( / index index1 ss p0 ss1 entn ent ty l_p1 l_p2 p1 p2 p3 p4 ang1 ang2
ang3 dist1 dist2 )
(defun inivar(); 四条直线快速修剪
(setq osm (getvar "osmode"))
(setq cly (getvar "clayer"))
)
(defun resvar()
(setvar "osmode" osm)
(setvar "clayer" cly)
)
(inivar) ;初始化系统变量
(setvar "blipmode" 1)
(setq index 1
ss (ssadd) ;构件一个空选择集
) ;setq end
(setvar "osmode" 512) ;设定捕捉模式为Nearest
(setq ss (ssget '((0 . "LINE"))))
(while (/= (sslength ss) 4)
(progn
(print "未选到四条直线,请重新选择")
(setq ss (ssget '((0 . "LINE"))))
)
)
(setvar "osmode" 0)
(setvar "blipmode" 0)
(setq index 0
l_p1 '()
l_p2 '()
) ;setq end
(repeat 4 ;获取每一根线的起点、终点
(setq ent (entget (ssname ss index))
index (+ 1 index)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
l_p1 (cons p1 l_p1)
l_p2 (cons p2 l_p2)
) ;setq end
) ;repeat end
(setq index 0 n 4
l_int '()
)
(repeat (1- n) ;计算交点
(setq p1(nth index l_p1)
p2(nth index l_p2)
index1 (1+ index)
index (1+ index)
) ;setq end
(repeat (- n index)
(setq p3 (nth index1 l_p1)
p4 (nth index1 l_p2)
index1 (1+ index1)
pt (inters p1 p2 p3 p4) ;求交点
l_int (if pt (cons pt l_int) l_int)
) ;setq end
);repeat end
) ;repeat end
(setq index 0
la (cdr (assoc 8 ent))
) ;setq end
(repeat n ;删除原直线
(setq entn (ssname ss index)
index (1+ index)
) ;setq end
(entdel entn)
) ;repeat end
(setq index 0)
(command "layer" "s" la "")
(repeat (1- n) ;重新画线
(setq p3 (nth index l_int)
index2 (1+ index)
index (1+ index)
) ;setq end
(repeat (- n index)
(setq index1 0
p4 (nth index2 l_int)
index2 (1+ index2)
) ;setq end
(repeat n
(setq p1(nth index1 l_p1)
p2(nth index1 l_p2)
index1 (1+ index1)
) ;setq end
(setq ang1 (angtos (angle p1 p2) 0 1)
ang2 (angtos (angle p1 p3) 0 1)
ang3 (angtos (angle p1 p4) 0 1)
) ;setq end
(if (= ang1 ang2 ang3)
(progn
(setq dist1 (distance p1 p3)
dist2 (distance p1 p4)
) ;set end
(if (< dist1 dist2)
(progn
(command "line" p1 p3 "")
(command "line" p4 p2 "")
) ;progn end
(progn
(command "line" p1 p4 "")
(command "line" p3 p2 "")
) ;progn end
) ;if end
) ;progn end
);if end
) ;repeat end
) ;repeat end
) ;repeat end
(redraw)
(resvar) ;还原系统变量
(princ)
) ;defun end
框内一点式
(defun c:tt(/ ELAST1 ENT LST MP1 MP2 MP3 MP4 P0 P1 P2 P3 P4 P5 X Y)
(vl-load-com)
(defun sk_dxf(ent code)(cdr(assoc code (entget ent))))
(defun sk_m2p (p1 p2)(mapcar '(lambda(x y)(* 0.5 (+ x y))) p1 p2))
(if(setq p0(getpoint "\n在框内指定一点:"))
(progn
(setq elast1(entlast))
(command "-BOUNDARY" p0 "")
(setq ent(entlast))
(if(and (= (sk_dxf ent 0) "LWPOLYLINE")(/= (sk_dxf ent 5)(sk_dxf elast1 5)))
(progn
(setq lst(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent))))
(setq p1(car lst)
p2(cadr lst)
p3(caddr lst)
p4(cadddr lst)
mp1(sk_m2p p1 p2)
mp2(sk_m2p p2 p3)
mp3(sk_m2p p3 p4)
mp4(sk_m2p p4 p1)
)
(princ (list mp1 mp2 mp3 mp4))
(entdel ent)
(command "trim" "" "c" mp1mp3 "" )
(command "trim" "" "c" mp2mp4 "" )
)
)
)
)
(princ)
) 434939575 发表于 2014-5-28 10:41 static/image/common/back.gif
(defun C:T4( / index index1 ss p0 ss1 entn ent ty l_p1 l_p2 p1 p2 p3 p4 ang1 ang2
...
很厉害，框选能剪出效果，请问能实现多处框选吗，比如第一个位置剪完了，再继续去剪其他位置吗 edata 发表于 2014-5-28 14:35 static/image/common/back.gif
框内一点式
不用选。直接点击框内就可以达到理想效果，可否连续进行多次呢，这样不用弄一次敲一下回车了假如数量很大的话 尽量修剪直线，多段线有时候不是很正确。
(defun c:tt(/ ELAST1 ENT LST MP1 MP2 MP3 MP4 P0 P1 P2 P3 P4 P5 X Y)
(vl-load-com)
(setq cmd_e(getvar 'cmdecho))
(setvar 'cmdecho 0)
(defun sk_dxf(ent code)(cdr(assoc code (entget ent))))
(defun sk_m2p (p1 p2)(mapcar '(lambda(x y)(* 0.5 (+ x y))) p1 p2))
(while(setq p0(getpoint "\n在框内指定一点:"))
(progn
(setq elast1(entlast))
(command "-BOUNDARY" p0 "")
(setq ent(entlast))
(if(and (= (sk_dxf ent 0) "LWPOLYLINE")(/= (sk_dxf ent 5)(sk_dxf elast1 5)))
(progn
(setq lst(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10 (car x)))(entget ent))))
(setq p1(car lst)
p2(cadr lst)
p3(caddr lst)
p4(cadddr lst)
mp1(sk_m2p p1 p2)
mp2(sk_m2p p2 p3)
mp3(sk_m2p p3 p4)
mp4(sk_m2p p4 p1)
)
(entdel ent)
(command "trim" "" "c" mp1mp3 "" )
(command "trim" "" "c" mp2mp4 "" )
)
)
)
)
(and cmd_e(setq cmd_e(getvar 'cmdecho)))
(princ)
) 向楼主学习！初研CAD开发！ 高手如云啊.请收下我的膝盖 学习了学习了 学习了，基础知识
页:
[1]