8
35
4
初露锋芒
(if (= (getvar "acadver") "14.0" ) (setq cadver 14) (setq cadver 15) ) (if (= cadver 15) (vl-load-com)) (defun getunlocklayer(/ layer lay_list ) (setq layer (tblnext "layer" T)) (if (= (cdr (assoc 70 layer) ) 0) (setq lay_list (list (cons 8 (cdr (assoc 2 layer))))) ) (setq layer (tblnext "layer")) (while layer (if (= (cdr (assoc 70 layer) ) 0) (setq lay_list (append lay_list (list (cons 8 (cdr (assoc 2 layer)))))) ) (setq layer (tblnext "layer")) ) (append (cons (cons -4 ""))) ) (setq trss nil)(defun c:tr ( / ss ssx i entlist pointlist entpointlist getpo minx miny maxx maxy entlen objtype minp maxp sstemp sslen entlent distentlist distlist listlen dist trimobj trss ) (defun pointatrec ( point rec / minx miny maxx maxy ) (setq minx (min (car (car rec)) (car (cadr rec)) (car (caddr rec)) (car (caddr rec)))) (setq maxx (max (car (car rec)) (car (cadr rec)) (car (caddr rec)) (car (caddr rec)))) (setq miny (min (cadr (car rec)) (cadr (cadr rec)) (cadr (caddr rec)) (cadr (caddr rec)))) (setq maxy (max (cadr (car rec)) (cadr (cadr rec)) (cadr (caddr rec)) (cadr (caddr rec)))) (if (and (>= (car point) minx) (= (cadr point) miny) (vla-object ent)) (cond ((pointatrec (vlax-curve-getClosestPointTo vlaobj (car reclist)) reclist) (setq polistok (append polistok (list (vlax-curve-getClosestPointTo vlaobj (car reclist)))))) ((pointatrec (vlax-curve-getClosestPointTo vlaobj (cadr reclist)) reclist) (setq polistok (append polistok (list (vlax-curve-getClosestPointTo vlaobj (cadr reclist)))))) ((pointatrec (vlax-curve-getClosestPointTo vlaobj (caddr reclist)) reclist) (setq polistok (append polistok (list (vlax-curve-getClosestPointTo vlaobj (caddr reclist)))))) ((pointatrec (vlax-curve-getClosestPointTo vlaobj (cadddr reclist)) reclist) (setq polistok (append polistok (list (vlax-curve-getClosestPointTo vlaobj (cadddr reclist)))))) (T nil) ) (if (zerop (length polistok)) nil (append (list ent) polistok) ) ) (princ "\n智能TRIM由luoyaya编制,欢迎访问luoyaya.nease.net\n") (princ "\n请用C交叉窗口方式选择对象!") (if (setq ss (ssget (getunlocklayer))) (progn (setq ssx (ssnamex ss ));SSX格式为 ((选择方式ID 图元名 0 多边形选择区ID) (setq i (1- (length ssx))) ; (多边形选择区ID ( 0 点坐标))) (setq entlist (list)) (setq pointlist (list)) ;(setq ts (getvar "cdate")) (while (> i -1) (cond ((= (car (nth i ssx)) 3) ; 取SSX中的图元名 取得多边形区ID (setq entlist (append entlist (list (list (last (nth i ssx)) (nth 1 (nth i ssx))))))) (( i -1) (if (setq getpo (getentpointlist (cadr (nth i entlist)) (cdr (assoc (car (nth i entlist)) pointlist)))) (setq entpointlist (append entpointlist (list getpo ) ) );生成一个(被选中的对象中的端点 对象图元名)的表 ) (setq i (1- i)) );第一步完成 ;(setq te (getvar "cdate") tt (* 1000000 (- te ts))) ;(princ (strcat "\n第一步完成了.共耗时"(rtos tt 2 4) "秒..."))(setq entlen (1- (length entpointlist))) (setq ssa (ssadd)) (setq objtype '((-4 . ""))) (while (> entlen -1) (vla-getboundingbox (vlax-ename->vla-object (car (nth entlen entpointlist))) 'minp 'maxp ) (if (= cadver 15) (setq minp (vlax-safearray->list minp) maxp (vlax-safearray->list maxp) )) ;for 200X (if (setq sstemp (ssget "c" minp maxp objtype )) (progn (setq i (1- (sslength sstemp))) (while (> i -1) (setq ssa (ssadd (ssname sstemp i ) ssa )) (setq i (1- i)) ) ) ) (setq entlen (1- entlen)) ) ;(setq te (getvar "cdate") tt (* 1000000 (- te ts))) ;(princ (strcat "\n第二步完成了.共耗时"(rtos tt 2 4) "秒...")) ;开始选择TRIM的对象 ;(setq ssa (ssget "c" (list minx miny) (list maxx maxy) '((-4 . "")) )) (setq sslen (1- (sslength ss))) (while (> sslen -1) (if (setq sstemp (ssdel (ssname ss sslen) ssa)) (setq ssa sstemp) ) (setq sslen (1- sslen)) ) (if (not (zerop (sslength ssa))) (progn ;判断SSA中对象和ENTPOINTLIST中对象是否有交点 (setq sslen (1- (sslength ssa)) entlen (1- (length entpointlist))
