[分享]在明经的所有老师指导下，完成的第一个作品。帮我看看有什么改进的。
;;;用于在某范围内对平面图进行修剪，分割平面图或删除平面图上的某一部分。<BR>;;;命令【out】将修剪和清除矩形框外部的所有实体，并保留边界<BR>;;;命令【in】将修剪和清除矩形框内部的所有实体，不保留边界<BR>(defun c:cut (/ a p1 p2 p1x p1y p2x p2y p3 p4 dst ang<BR> p1a p2a pax1 pay1 pax2 pay2 p3a p4a lst)<BR> (graphscr)<BR> (cmdla0)<BR> (setq p1 (getpoint "\n选择矩形框的第一角：")<BR> p2 (getcorner p1 "\n选择矩形框的另一角："))<BR> (setq a (getstring "\n清除矩形框的外部或内部 in<out>："))<BR> (setq p1x (car p1)<BR> p1y (cadr p1)<BR> p2x (car p2)<BR> p2y (cadr p2))<BR> (setq p3 (list p2x p1y)<BR> p4 (list p1x p2y))<BR> (setq dst (/ (distance p1 p2) 1000.0);;;注一<BR> ang (angle p1 p2))<BR> (if (/= a "in")<BR> (setq p1a (polar p1 ang (- 0 dst))<BR> p2a (polar p2 ang dst))<BR> (setq p1a (polar p1 ang dst)<BR> p2a (polar p2 ang (- 0 dst)))<BR> )<BR> (setq pax1 (car p1a)<BR> pay1 (cadr p1a)<BR> pax2 (car p2a)<BR> pay2 (cadr p2a))<BR> (setq p3a (list pax2 pay1)<BR> p4a (list pax1 pay2))<BR> (setvar "osmode" 0)<BR> (setvar "highlight" 0)<BR> (command "_.pline" p1 p3 p2 p4 "_c")<BR> (setq lst (entlast))<BR> (command "_.trim" lst "" "_f" p1a p3a "" "_f" p3a p2a ""<BR> "_f" p2a p4a "" "_f" p4a p1a "" "")<BR> (if (/= a "in")<BR> (command "_erase" "all" "_r" "_c" p1 p2 "")<BR> (command "_erase" "_w" p1 p2 "")<BR> )<BR> (cmdla1)<BR> (princ)<BR> )<BR>(defun CMDLA0 () ;;;;此处有几条没有的，但懒得删，<BR> (setq cmd (getvar "CMDECHO")) <BR> (setq oom (getvar "orthomode")) <BR> (setq osm (getvar "osmode"))<BR> (setq hlt (getvar "highlight"))<BR> (setq rmode (getvar "regenmode")) <BR> (setvar "regenmode" 0)<BR> (setvar "CMDECHO" 0) <BR> (princ) <BR>) <BR>(defun CMDLA1 () <BR> (setvar "CMDECHO" cmd) <BR> (setvar "orthomode" oom) <BR> (setvar "osmode" osm)<BR> (setvar "highlight" hlt)<BR> (setvar "regenmode" rmode)<BR> (princ)<BR>) <BR>;;;---------------76067133@qq.com----------------- <BR>;;;END注一中的，栏选框和矩形框的距离，我试了，5000，和，2000，结果切割得不理想，但，用了，1000，还是有点不理想。老师们，帮我这小学生看看有什么要改进的呀？
还有，我现在在研究关于建筑制图中，怎么自动修剪墙线，问题卡在，对所有直线交点打断上面了。飞老师给我的那个关于求交点打断的函数。好象打断的效果并不好，一碰到四条平行线互相垂直，就打不断，还多了些重复的线。不知能不能改改，当然，若能教我看懂那个，breaks子程序就更好了。那儿有一些我看不懂。 (setq p3 (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)))<BR> p4 (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2)))<BR>)<BR>(if (/= a "i");;输入两个字符太麻烦<BR> (setq p1a (list (- (car p3) 0.00000001) (- (cadr p3) 0.00000001))<BR> p2a (list (+ (car p4) 0.00000001) (+ (cadr p4) 0.00000001))<BR> )<BR> (setq p1a (list (+ (car p3) 0.00000001) (+ (cadr p3) 0.00000001))<BR> p2a (list (- (car p4) 0.00000001) (- (cadr p4) 0.00000001))<BR> )<BR> )<BR>(command "zoom" "w" (list (- (car p3) 0.1)(- (cadr p3) 0.1))(list (+ (car p3) 0.1)(+ (cadr p3) 0.1)))<BR>(command "_.trim" lst "" "_f" p1a p3a p2a p4a p1a "" "")<BR>(command "_.trim" lst "" "_f" p1a p3a p2a p4a p1a "" "")<BR>;;来两次 y谢谢指点，万分感谢。送你一朵鲜花。再次谢谢，呵呵。主意太好了。 我发现了为什么修剪不理想的原因了，主要是虚线在，栏选第一框没选到，所以出现漏剪现象，我现在多加了一个虚框，把问题解决了，多谢二楼给我的提示。 本帖最后由 作者 于 2004-12-25 19:49:00 编辑
;;;用于在某范围内对平面图进行修剪，分割平面图或删除平面图上的某一部分。
(defun c:cut (/ p1 p2 p3 p4 dst ang p1a p2a p3a p4a lst)
(graphscr)
(cmdla0)
(setqp1 (getpoint "\n选择矩形框的第一角：")
p2 (getcorner p1 "\n选择矩形框的另一角：")
)
(setvar "osmode" 0)
(command "undo" "be")
(command "rectang" p1 p2)
(setq lst (entlast))
(setqtxt5 (ukword 1 "1 2" "\n请选择清除范围：1-外部/2-内部" txt5)
p3 (list (car p2) (cadr p1))
p4 (list (car p1) (cadr p2))
dst (/ (distance p1 p2) 100.0)
ang (angle p1 p2)
)
(if (= txt5 "1")
(setq p1a (polar p1 ang (- 0 dst))
p2a (polar p2 ang dst)
)
(setq p1a (polar p1 ang dst)
p2a (polar p2 ang (- 0 dst))
)
)
(setqp3a (list (car p2a) (cadr p1a))
p4a (list (car p1a) (cadr p2a))
)
(command "_.trim" lst "" "f" p1a p3a p2a p4a p1a "" "")
(if (= txt5 "1")
(command "_erase" "all" "_r" "_c" p1 p2 "")
(command "_erase" "_w" p1 p2 "")
)
(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 ukword (bit kwd msg def / inp)
(if (and def (/= def ""))
(setq msg (strcat "\n" msg "<" def ">:")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ":"))
)
(initget bit kwd)
(setq inp (getkword msg))
(if inp
inp
def
)
)
;;;END 好东西，学习了，，， 院长的好用 支持。。。。。。。。。
页:
[1]