[讨论]有關自動旋轉對象到最小包絡框的處理方法

BDYCAD · 发表于 2004-10-5 18:31:00

程序如下:;;;程序名: BDY:SmallRectang
;;;程序负责的工作: 把所选的对象自动转到最小的包络框.
;;;设计：ＢＤＹＣＡＤ
;;;时间：２００４－１０－０４
;;;使用举例　　(BDY:SmallRectang (SSGET))
(defun BDY:SmallRectang (sel-ssget / pparear i pt pparear smmm ptc)
   (SETQ pparear nil i 0)
   (repeat 90
   (setq pt (LRCenterPoint sel-ssget))
   (vl-cmdf ".area" (car pt) (list (car (cadr Pt) ) (cadr pt1))
   (cadr Pt)    (list (car pt1 ) (cadr (cadr Pt))) "")
   (setq pparear (append pparear (list(list (getvar "area") i))))
   (vl-cmdf ".rotate" sel-ssget "" (caddr pt) 1)
   (SETQ i (+ i 1)))
   (setq smmm (cadr(CAR (vl-sort pparear (function (lambda (e1 e2)(vla-object ENT) 'LL 'UR)
   (mapcar 'vlax-safearray->list (list LL UR)))
   (setq n 0)
   (repeat (sslength ss)
   (setq PT_LIST (append PT_LIST (LRCenterPoint-a (ssname ss n))))
   (setq n (1+ n)))
   (setq pt1a(CAR (vl-sort PT_LIST (function (lambda (e1 e2)((cadr e1) (cadr e2)) ) ) )))
   (setq pt2b(CAR (vl-sort PT_LIST(function (lambda (e1 e2)(>(car e1) (car e2)) ) ) )))
   (setq pt1 (list (car pt1b) (cadr pt1a)) pt2 (list (car pt2b) (cadr pt2a)))
   (setq pt_x1 (car pt1) pt_x2 (car pt2))
   (setq pt_xc (+ (abs (/ (- pt_x2 pt_x1) 2)) pt_x1))
   (setq pt_y1 (cadr pt1) pt_y2 (cadr pt2))
   (setq pt_yc (+ (abs (/ (- pt_y2 pt_y1) 2)) pt_y1))
   (setq pt_xy (list pt_xc pt_yc))
   (list pt1 pt2 pt_xy)
   )