本帖最后由 作者 于 2007-8-30 2:01:25 编辑
试试我的代码 (defun c:txjq3 (/ aa oldgroup oldcmd oldblip oldsnap en dp az px p1 ss1 ss2 sc en1 az1 p2 pn1 pn2 px1 pxmax ) (setvar "LUPREC" 8) (setq oldgroup (getvar "pickstyle")) ;保存编组开关 (setvar "pickstyle" 0) ;关闭编组 (setq oldcmd (getvar "cmdecho")) ;保存控制 command 函数运行期间,AutoCAD 是否回显提示和输入 (setvar "cmdecho" 0) ;关闭command 函数运行期间,AutoCAD 回显提示和输入 (setq oldblip (getvar "blipmode")) ;保存控制点标记 (setvar "blipmode" 0) ;关闭点标记 (setq oldsnap (getvar "osmode")) ;保存对象捕捉方式 (setvar "osmode" 0) ;关闭对象捕捉式 (while (or (= (if (= (setq en (nentselp "\n选择作为剪切边界的闭合多段线:")) nil ) (setq aa "空选择!") ) "空选择!" ) (= (if (/= (cdr (assoc 0 (entget (car en)))) "LWPOLYLINE") (setq aa "类型错误!") ) "类型错误!" ) (= (if (and (/= (cdr (assoc 70 (entget (car en)))) 129) (/= (cdr (assoc 70 (entget (car en)))) 1) ) (setq aa "线段不闭合!") ) "线段不闭合!" ) ) (alert (strcat "选择错误-" aa ",重新选择!")) ) ;选择控制 (setq ent (car en)) (setvar "osmode" oldsnap) (setvar "osmode" 16383) (setq dp (getpoint "\n请选择一点作为剪切基点.......")) (setvar "osmode" 0) (setq az (entget (car en))) (setq px (list)) (while (assoc 10 az) (setq p1 (cdr (assoc 10 az))) (setq az (cdr (member (assoc 10 az) az))) (setq px (cons p1 px)) ) (setq pxmax(list (apply 'mapcar (cons 'min px)) (apply 'mapcar (cons 'max px)) )) (command "zoom" "w" (car pxmax) (cadr pxmax)) (setq ss (ssget "cp" px)) (vl-cmdf "copy" ss "" dp pause) (setq dp1 (getvar "lastpoint")) (vl-cmdf "copy" en "" dp dp1) (setq en (entlast)) (print "\n正在剪切复制选中的图形,请稍侯......") (setq px (list)) (while (assoc 10 az) (setq p1 (cdr (assoc 10 az))) (setq az (cdr (member (assoc 10 az) az))) (setq px (cons p1 px)) ) (setq sc en) (command "offset" 0.1 sc dp "") (setq en1 (entlast)) (setq az1 (entget en1)) (setq px1 (list)) (while (assoc 10 az1) (setq p2 (cdr (assoc 10 az1))) (setq az1 (cdr (member (assoc 10 az1) az1))) (setq px1 (cons p2 px1)) ) (setq px1 (cons (car px1) (reverse px1))) (command "erase" en1 "") (while (setq pn1 (car px1) pn2 (cadr px1) ) (command "trim" en "" "f" pn1 pn2 "" "") (if (setq del (ssget "f" (list pn1 pn2))) (command "erase" del "") ) (setq px1 (cdr px1)) ) (setvar "LUPREC" 8) (setvar "pickstyle" oldgroup) (setvar "cmdecho" oldcmd) (setvar "blipmode" oldblip) (setvar "osmode" oldsnap) (princ) ) 怎么加载不用多说吧! 图形剪切边界接触哦到块的话,请先分解块,剪切出来的图形复制在本图内, 如果要另存,请用带基点复制到新图。 |