发一个TRIM工具,主要是自动选择修剪对象,
希望大家帮我完善一下,看看有没有什么不好的地方(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"<OR") lay_list) (list (cons -4"OR>")))
)
(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) (<= (car point) maxx) (>= (cadr point) miny) (<= (cadr point) maxy))
T
nil
)
)
(defun getentpointlist( ent reclist / entlist polistok vlaobj )
(setq entlist (entget ent)
; enttype (cdr (assoc 0 entlist))
polistok (list)
vlaobj (vlax-ename->vla-object ent))
(cond
((pointatrec (vlax-curve-getClosestPointTo vlaobj (car reclist)) reclist)
(setqpolistok (append polistok (list (vlax-curve-getClosestPointTo vlaobj (car reclist))))))
((pointatrec (vlax-curve-getClosestPointTo vlaobj (cadr reclist)) reclist)
(setqpolistok (append polistok (list (vlax-curve-getClosestPointTo vlaobj (cadr reclist))))))
((pointatrec (vlax-curve-getClosestPointTo vlaobj (caddr reclist)) reclist)
(setqpolistok (append polistok (list (vlax-curve-getClosestPointTo vlaobj (caddr reclist))))))
((pointatrec (vlax-curve-getClosestPointTo vlaobj (cadddr reclist)) reclist)
(setqpolistok (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 (appendentlist (list (list (last (nth i ssx)) (nth 1 (nth i ssx)))))))
((< (car (nth i ssx)) 0)
(setq pointlist (append pointlist (list (list
(car (nth i ssx))
(trans (cadr (cadr (nth i ssx))) 1 0)
(trans (cadr (caddr (nth i ssx))) 1 0)
(trans (cadr (cadddr (nth i ssx))) 1 0)
(trans (cadr (last (nth i ssx))) 1 0)
)
)
)
)
)
(T nil)
)
(setq i (1- i))
)
(if (zerop (length entlist))
(princ "\n请用C交叉窗口方式选择对象!")
(progn
(setq i (1- (length entlist)))
(setq entpointlist nil)
(while (> 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 . "<OR") (0 . "LINE") (0 . "CIRCLE") (0 . "ellipse") (0 . "ARC") (0 . "SPLINE") (0 . "LWPOLYLINE") (-4 . "OR>")))
(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 maxpobjtype))
(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 . "<OR") (0 . "LINE") (0 . "CIRCLE") (0 . "ellipse") (0 . "ARC") (0 . "SPLINE") (0 . "LWPOLYLINE") (-4 . "OR>")) ))
(setq sslen (1- (sslength ss)))
(while (> sslen -1)
(if (setq sstemp (ssdel (ssnamess 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))
entlent entlen
sstemp ssa
ssa (ssadd))
(if (= cadver 15)
(progn
(while (> sslen -1)
(while (> entlen -1)
(if (not (vl-catch-all-error-p
(vl-catch-all-apply 'vlax-safearray->list
(list (vlax-variant-value (vla-IntersectWith
(vlax-ename->vla-object (ssname sstemp sslen))
(vlax-ename->vla-object (car (nth entlen entpointlist)))
0
)
)
)
)
))
(setq ssa (ssadd (ssname sstemp sslen) ssa)
;sslen (1- sslen)
entlen -1)
)
;(setq ssa (ssdel (ssname ssa sslen) ssa)
; sslen (1- sslen)
; entlen entlent)
;(if (< sslen 0)(setq entlen -2))
(setq entlen (1- entlen))
)
(setq sslen (1- sslen)
entlen entlent)
))
(progn
(while (> sslen -1)
(while (> entlen -1)
(if (vla-IntersectWith (vlax-ename->vla-object (ssname sstemp sslen))
(vlax-ename->vla-object (car (nth entlen entpointlist)))
0
)
(setq ssa (ssadd (ssname sstemp sslen) ssa)
;sslen (1- sslen)
entlen -1)
)
;(setq ssa (ssdel (ssname ssa sslen) ssa)
; sslen (1- sslen)
; entlen entlent)
;(if (< sslen 0)(setq entlen -2))
(setq entlen (1- entlen))
)
(setq sslen (1- sslen)
entlen entlent)
))
)
;(setq te (getvar "cdate") tt (* 1000000 (- te ts)))
;(princ (strcat "\n第三步完成了.共耗时"(rtos tt 2 4) "秒..."))
(setq sslen (1- (sslength ssa)));取得SS个数
(if (> sslen 500)
(progn
(if (member (getstring (strcat "自动选择的对象有"
(vl-princ-to-string sslen)
"个,是否自己选择?y/n"
)
)
'("n" "N")
)
(progn
(setq distentlist
(list)
distlist (list)
)
(while (> sslen -1)
(setq listlen (1- (length entpointlist)))
(setq dist -1)
(while (> listlen -1)
(if (= dist -1)
(setq dist 0)
)
(setq dist
(+ (distance
(vlax-curve-getClosestPointTo
(vlax-ename->vla-object (ssname ssa sslen))
(cadr (nth listlen entpointlist))
)
(cadr (nth listlen entpointlist))
) ;取得ENTPOINTLIST中点与SSa中线的距离
dist
)
)
(setq listlen (1- listlen))
)
(if (/= dist -1)
(setq distentlist (append
distentlist
(list (list dist (ssname ssa sslen)))
)
distlist (append distlist (list dist))
)
)
(setq sslen (1- sslen))
)
(setq trimobj
(cadr (assoc (apply 'min distlist) distentlist))
;trimobjcopy trimobj
) ;查找最近的线
(redraw trimobj 3) ;亮显最近的线
(princ "\n如果不是这条剪切边请选择,如果是请回车:")
(setq trss (ssget))
(redraw trimobj 4) ;不亮显最近的线
(if (not trss)
(setq trss trimobj)
)
)
(progn
(princ "\n请选择剪切边:")
(setq trss (ssget))
)
)
)
(progn
(setq distentlist
(list)
distlist (list)
)
(while (> sslen -1)
(setq listlen (1- (length entpointlist)))
(setq dist -1)
(while (> listlen -1)
;;;;```因entpointlist第一项为nil所以>0
(if (= dist -1)
(setq dist 0)
)
(setq dist
(+ (distance
(vlax-curve-getClosestPointTo
(vlax-ename->vla-object (ssname ssa sslen))
(cadr (nth listlen entpointlist))
)
(cadr (nth listlen entpointlist))
) ;取得ENTPOINTLIST中点与SSa中线的距离
dist
)
)
(setq listlen (1- listlen))
)
(if (/= dist -1)
(setq distentlist (append distentlist
(list (list dist (ssname ssa sslen)))
)
distlist (append distlist (list dist))
)
)
(setq sslen (1- sslen))
)
(setq
trimobj (cadr (assoc (apply 'min distlist) distentlist))
) ;查找最近的线
(if trimobj
(progn
(redraw trimobj 3) ;亮显最近的线
(princ "\n如果不是这条剪切边请选择,如果是请回车:")
(setq trss (ssget))
(redraw trimobj 4) ;不亮显最近的线
(if (not trss)
(setq trss trimobj)
)
)
(progn
(princ "\n找不到剪切边,请选择:")
(setq trss (ssget))
))
)
)
)
(progn
(princ "\n找不到剪切边,请选择:")
(setq trss (ssget))
))
(if (not trss)
(princ "\n未选择剪切边,不剪切!")
(progn
(command "_.trim" trss "")
(setq sslen (1- (length entpointlist)))
(while (> sslen -1)
(command (nth sslen entpointlist))
(setq sslen (1- sslen))
)
(command)
))
)
)
)
(princ "\n未选择被剪切边!"))
(princ)
) 用法见图 用法见图 没人理,惨 用不着这么麻烦写这个！AutoCAD本身就有这个功能！在你先择要修剪物体的时候，打F就可以选择多个物体一起修剪。试试。 不一样的啊,我这个不用F选用C选,然后是自动选线 再說詳細有甚麼功能好嗎?
(最好能說說思路__看不出為甚麼程序要那麼長!)
页:
[1]