本帖最后由 tryhi 于 2016-4-5 22:20 编辑
- (defun c:tt (/ enla enlist lst old pllst ss ss2)
- (vl-Load-COM)
- (setq ss(ssget '((0 . "LINE")))enla(entlast))
- (command "_pedit" "m" ss "" "" "j" "" "")
- (setq ss2(try-ssend enla)
- enlist(ss2EnList ss2)
- lst(mapcar 'getbox enlist)
- pllst (mapcar '_pt7 lst)
- old (getvar "osmode")
- )
- (setvar "osmode" 0)
- (foreach n pllst (apply 'command (cons "pline" n)))
- (setvar "osmode" old)
- )
- (defun _pt7 (ptlst / p2 p4 p6 pt4 x)
- (setq pt4(try-pt2-to-pt4 (car ptlst)(cadr ptlst))
- x(* 0.25 (distance (setq p2(cadr pt4))(setq p4(cadddr pt4))))
- p6 (polar p2 (angle (cadr pt4)p4) x))
- (append pt4 (list (car ptlst) p6 (cadr ptlst) ""))
- )
- (defun ss2EnList(ss / a en lst)
- (setq a -1)
- (while
- (setq en(ssname ss(setq a(1+ a))))
- (setq lst(cons en lst))
- )
- )
- (defun getbox(e)
- (vla-GetBoundingBox (vlax-ename->vla-object e) 'p1 'p2);取得包容图元的最大点和最小点
- (list (vlax-safearray->list p1) (vlax-safearray->list p2))
- )
- (defun try-pt2-to-pt4 (pt1 pt2)
- (list pt1 (list(car pt1)(cadr pt2))pt2(list (car pt2)(cadr pt1)))
- )
- (defun try-ssend(en / ss)
- (setq ss (ssadd))
- (while (setq en(entnext en))
- (setq ss(ssadd en ss))
- )
- ss
- )
完全按照楼主思路写的代码,另外提示一句,楼主开洞的位置是左上角的点往右下角偏0.3宽度,这样的不对的,当宽很大高很窄的时候就会出错,所以这里改了一下,改为开洞位置为左上至右下对角线的四分之一处 |