本帖最后由 作者 于 2004-12-25 19:35:46 编辑
;;;考虑不全，应付楼主图示应该没问题。(defun c:test023 (/ p1 p2 p3 p4 dst ang p1a p2a p3a p4a lst)
(cmdla0)
(setq no1 (ureal 1 "" "打断距离" no1))
(while (setq e (car (entsel "\n选择Ａ层线<退出> : ")))
(setq pt1 (vlax-curve-getstartPoint e)
pt2 (vlax-curve-getEndPoint e)
p1 (polar pt1 (* pi 1.5) (/ no1 2))
p2 (polar pt2 (* pi 0.5) (/ no1 2))
p3 (list (car p2) (cadr p1))
p4 (list (car p1) (cadr p2))
dst (/ (distance p1 p2) 100.0)
ang (angle p1 p2)
p1a (polar p1 ang dst)
p2a (polar p2 ang (- 0 dst))
p3a (list (car p2a) (cadr p1a))
p4a (list (car p1a) (cadr p2a))
)
(setvar "osmode" 0)
(command "undo" "be")
(command "rectang" p1 p2)
(setq lst (entlast))
(command "_.trim" lst "" "f" p1a p3a p2a p4a p1a "" "")
(entdel lst)
(command "undo" "e")
)
(cmdla1)
)
(defun CMDLA0 ()
(setq cmd (getvar "CMDECHO"))
(setq oom (getvar "orthomode"))
(setq osm (getvar "osmode"))
(setq hlt (getvar "highlight"))
(setq rmode (getvar "regenmode"))
(setvar "regenmode" 0)
(setvar "CMDECHO" 0)
(princ)
)
(defun CMDLA1 ()
(setvar "CMDECHO" cmd)
(setvar "orthomode" oom)
(setvar "osmode" osm)
(setvar "highlight" hlt)
(setvar "regenmode" rmode)
(princ)
)
(defun ureal (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp
inp
def
)
)
;;;END
先谢谢版主了！
但A层的线，自动把B层的线在A层的一个范围A值内打断还是不很啊，只可以垂直线自动打断！
还有如果可以加上在图中点取距离就更好了：）
<A name=1406><FONT color=#990000><B>xyp1964</B></FONT></A>
今测试了一下．发现了一个问题．．
在选择Ａ层线后，，它把全部与它相交的东西都打断了，
我只是想它自动打断line．．
1.批量处理,基本上满足需求 2..有bug,有时无法一次处理乾净,请有心人再完善(defun c:bkab()
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq selnum (getvar "osmode"))
(setvar "osmode" 0)
(setq width (getreal "\n打断距离 < 80 > :"))
(if (= width nil)(setq width 80))
(setq width (/ width 2.0)) (setq ss (ssget))
(setq ss (ssget "p" '((0 . "LINE"))))
(setq kk 0)
(setq j 0)
(repeat (- (sslength ss) 1)
(setq sname1 (ssname ss j))
(setq endata1 (entget sname1))
(setq p1s (cdr (assoc 10 endata1)))
(setq p1e (cdr (assoc 11 endata1)))
(setq p1lay (cdr (assoc 8 endata1)))
(setq ang11 (angle p1s p1e))
(setq ang12 (angle p1e p1s))
(setq i (- (sslength ss) j 1))
(setq jj (+ j 1))
(repeat i
(setq sname2 (ssname ss jj))
(setq endata2 (entget sname2))
(setq p2s (cdr (assoc 10 endata2)))
(setq p2e (cdr (assoc 11 endata2)))
(setq p2lay (cdr (assoc 8 endata2)))
(setq ang21 (angle p2s p2e))
(setq ang22 (angle p2e p2s))
(setq jj (+ jj 1))
(setq pk (inters p1s p1e p2s p2e))
(if (/= pk nil)
(progn
(if (and (= p1lay "A")(= p2lay "B"))
(progn
(setq pp1 (polar pk ang22 width))
(setq pp2 (polar pk (- ang22 pi) width))
(command "break" sname2 pp1 pp2)
)
(progn
(if (and (= p1lay "B")(= p2lay "A"))
(progn
(setq pp1 (polar pk ang12 width))
(setq pp2 (polar pk (- ang12 pi) width))
(command "break" sname1 pp1 pp2)
)
)
)
)
(setq kk (+ kk 1))
)
)
) (setq j (+ j 1))
)
(setvar "osmode" selnum)(prin1)
)
很感谢<A name=1933><FONT color=#000066><B>f5612140</B></FONT></A>的帮忙。。
不过我试了。一点反应都没有的？到底是什么一会事吗？
我用的是2002。
请上传图档看看
是否是"line"及A,B图层
pfrynwgkq发表于2004-12-23 19:42:00static/image/common/back.gifxyp1964
今测试了一下．发现了一个问题．．
在选择Ａ层线后，，它把全部与它相交的东西都打断了，
...
打断得“太很了”！
不知要打断的是哪层线？<BR>
f5612140发表于2004-12-25 1:00:00static/image/common/back.gif请上传图档看看
是否是\"line\"及A,B图层
哦。。<BR>原来我没有留意到。不过有个BUG，一定要打图层名改成A,B才很，用起来有点烦锁，可以在图中选采吗？
<A name=2078><FONT color=#990000><B>xyp1964</B></FONT></A> ：打断得“太很了”！
不知要打断的是哪层线？<BR>
<BR>是打断所有的垂直LINE，注意一定在垂直的。。
<b><EM>f5612140：已解决了层与层之间的问题。</EM></b>