自动图框，自动坐标标注，自动边界盒，捡的别人的！！

xxxcondor

;   一、自定义图框说明
;       1、文件中的图框利用块定义属性功能，双击即可编辑图框明细表；
;       2、里面的图框可以自定义为自己公司的图框，但名字要改为一至；
;       3、自定义自己的图框时，图框大小要按实际尺寸绘制(A4,397*210)，坐标原点放到图框的中心位置。

;   二、自动图框加载说明
;       1、把图框文件tk_h,tk_v及PF_tools程序拷贝到燕秀的安装目录里，注意需保持文件的完整性；
;       2、CAD菜单栏—>工具—>加载应用程序—>启动组—>添加—>浏览找到“PF_tools”文件—>添加；
;       3、重新启动CAD，新建一个名为“0”的图层,即可开始使用自动图框。(之所以要建立名为“0”的图层，是因为“燕秀工具箱”新建图层有这个图层名，这个外挂是为了更方便地和“燕秀工具箱”一起使用。)

;   三、自动图框命令使用说明：
;       Hk=自动横向图框
;       sk=自动纵向图框
;       BJH=自动边界盒
;       ZD=自动坐标标注

===========================================
*******************************************
===========================================
;【PF工具箱--自动横向图框】
(defun c:HK()
   (setq mylayer (getvar "clayer"))
   (setq layname1 (substr mylayer 1 2))
   (setq layname2 (strcat layname1 "0"))
   (if(setq ed1 (tblsearch "LAYER" layname2))
     (progn
       (setq ed2 (cdr (assoc 70 ed1)))
       (cond
         ((= ed2 0)  (command "layer" "on" layname2 ""))
         ((= ed2 1)  (command "layer" "t" layname2 "on" layname2 ""))
         ((= ed2 4)  (command "layer" "u" layname2 "on" layname2 ""))
         ((= ed2 5)  (progn (command "layer" "t"  str3 "u" layname2 "on" layname2 "")))
       )
    )   
    (setq layname2 "0")
   )
   (command "layer" "s" layname2 "")
   (PRINC "\n【PF工具箱】--自动横向图框 ")(PRINC)
   (setq pt1 (getpoint "请选择图形左上角:\n"))
   (setq pt2 (getcorner pt1 "请选择图形右下角:\n"))
   (setq disx (abs (- (car pt1) (car pt2))))
   (setq disy (abs (- (cadr pt1) (cadr pt2))))
   (setq acx  (/ disx 297.00))
   (setq acy  (/ disy 165.00))
   (if (> acy acx)
       (setq acx acy)
   )
    (setq acx (*  (fix (+ (* acx 1.5) 0.9999)) 0.5))
   (setq acc (rtos acx 2 1))
   (setq pt0 (list (/ (+ (car pt1 ) (car pt2) (* (- 0 8) acx)) 2.00)
                   (/ (+ (cadr pt1) (cadr pt2) (* (- 0 23.6) acx)) 2.00)))

   (setq os (getvar "osmode"))
   (setvar "osmode" 0)
   (command "insert"  "tk_h.dwg" pt0 "x" acx "" "" "" "" "" "" "" "" "" "" ""
           acc  "" "" ""  "" )
   (setvar "osmode" os)

)

;【PF工具箱--自动纵向图框】
(defun c:SK()
   (setq mylayer (getvar "clayer"))
   (setq layname1 (substr mylayer 1 2))
   (setq layname2 (strcat layname1 "0"))
   (if(setq ed1 (tblsearch "LAYER" layname2))
     (progn
       (setq ed2 (cdr (assoc 70 ed1)))
       (cond
         ((= ed2 0)  (command "layer" "on" layname2 ""))
         ((= ed2 1)  (command "layer" "t" layname2 "on" layname2 ""))
         ((= ed2 4)  (command "layer" "u" layname2 "on" layname2 ""))
         ((= ed2 5)  (progn (command "layer" "t"  str3 "u" layname2 "on" layname2 "")))
       )
    )   
    (setq layname2 "0")
   )
   (command "layer" "s" layname2 "")
   (PRINC "\n【PF工具箱】--自动纵向图框 ")(PRINC)
   (setq pt1 (getpoint "请选择图形左上角:\n"))
   (setq pt2 (getcorner pt1 "请选择图形右下角:\n"))
   (setq disx (abs (- (car pt1) (car pt2))))
   (setq disy (abs (- (cadr pt1) (cadr pt2))))
   (setq acx  (/ disx 210.00))
   (setq acy  (/ disy 250.00))
   (if (> acy acx)
       (setq acx acy)
   )

   (setq acx (*  (fix (+ (* acx 1.5) 0.9999)) 0.5))
   (setq acc (rtos acx 2 1))
   (setq pt0 (list (/ (+ (car pt1 ) (car pt2) (* (- 0 8) acx)) 2.00)
                   (/ (+ (cadr pt1) (cadr pt2) (* (- 0 23.6) acx)) 2.00)))


   (setq os (getvar "osmode"))
   (setvar "osmode" 0)
   (command "insert"  "tk_v.dwg" pt0 "x" acx "" "" "" "" "" "" "" "" "" "" ""
           acc  "" "" ""  "" )
   (setvar "osmode" os)
   )

;【PF工具箱--自动边界盒】
(defun c:bjh (/ ss i l1 l2 ll ur os d)
  (setq os (getvar 'osmode))
  (PRINC "\n【PF工具箱--QQ交流群：214654218】--自动边界盒 ")(PRINC)  
  (setq d (getreal "\n偏距<5>"))
  (if (null d)
    (setq d 5)
  )
  (setq ss (ssget))
  (repeat (setq i (sslength ss))
    (vla-getboundingbox
      (vlax-ename->vla-object (ssname ss (setq i (1- i))))
      'll
      'ur
    )
    (setq l1 (cons (vlax-safearray->list ll) l1)
          l2 (cons (vlax-safearray->list ur) l2)
    )
  )
  (mapcar 'set
          (list 'll 'ur)
          (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
                  '(min max)
                  (list l1 l2)
          )
  )
  (command
    "rectang"
    (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
           0
           1
    )
    (trans (polar ur (* pi 0.25) d) 0 1)
  )
  (setvar 'osmode os)
  (princ)
)

;【PF工具箱--自动坐标标注】
(defun C:zd (/ dimt dimTad err txtSize s)
  (command "UNDO" "BE")
  (setq        dimt (getvar "DIMTMOVE")
        dimTad (getvar "DIMTAD")
        txtSize (getvar "TEXTSIZE")
        s (getvar "DIMSCALE")
  )
  (if (= s 0.0)
    (setq s 1.0)
  )
  (setvar "DIMTMOVE" 0)
  (setvar "DIMTAD" 0)
  (setvar "TEXTSIZE" (* s (getvar "DIMTXT")))
  (setq        err (vl-catch-all-apply 'ac-autoDim nil))
  (if (vl-catch-all-error-p err)
    (progn
      ;; add some error handles here
    )
  )
  (setvar "DIMTMOVE" dimt)
  (setvar "DIMTAD" dimTad)
  (setvar "TEXTSIZE" txtSize)
  (command "UNDO" "E")
)

;;;
;;; global variables: dd, posRec, stPos
;;; main function
(defun ac-autoDim(/ ss ent i inf pt-pairs xs ys x1 x2 y1 y2 xinfs yinfs sub-xinfs sub-yinfs xinf2 yinf2 cpt gap
                  dd posRec sEnt sEnts cirPak arcPak cirPaks arcPaks newCirPaks newArcPaks)
(PRINC "\n【PF工具箱】--自动坐标标注 ")(PRINC)
(setq ss (ssget)
        pt (getpoint "\n请指定坐标原点: ")
        ent (ssname ss 0)
        i 0
        dd (* (getvar "DIMSCALE") (+ (getvar "DIMTXT") (* 2.0 (getvar "DIMGAP"))))
        posRec (list nil nil nil nil nil nil nil nil)
  )
  (command "UCS" "O" pt)
  (while ent
    (setq inf (ac-dimInf ent))
    (if        inf
      (progn
        (setq sub-xinfs        (nth 0 inf)
              sub-yinfs        (nth 1 inf)
              xs        (append (nth 2 inf) xs)
              ys        (append (nth 3 inf) ys)
              sEnt (nth 4 inf)
              cirPak (nth 5 inf)
              arcPak (nth 6 inf)
        )
        (foreach xinf1 sub-xinfs
          (setq xinf2 (assoc (car xinf1) xinfs))
          (if xinf2
            (setq xinfs (subst (list (car xinf2) (cadr xinf2) (append (nth 2 xinf2) (nth 2 xinf1))) xinf2 xinfs))
            (setq xinfs (cons xinf1 xinfs))
          )
        )
        (foreach yinf1 sub-yinfs
          (setq yinf2 (assoc (car yinf1) yinfs))
          (if yinf2
            (setq yinfs (subst (list (car yinf2) (cadr yinf2) (append (nth 2 yinf2) (nth 2 yinf1))) yinf2 yinfs))
            (setq yinfs (cons yinf1 yinfs))
          )
        )
        (if sEnt
          ;; un-orthogonal line
          (setq sEnts (cons sEnt sEnts))
        )
        (if cirPak
          (setq cirPaks (cons cirPak cirPaks))
        )
        (if arcPak
          (setq arcPaks (cons arcPak arcPaks))
        )
      )
    )
    (setq i (1+ i)
          ent (ssname ss i)
    )
  )
  ;; find the center of objects
  (setq x1 (apply 'min xs)
        x2 (apply 'max xs)
        y1 (apply 'min ys)
        y2 (apply 'max ys)
        cpt (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0) 0.0)
        gap (* 2.0 dd)
        stPos (list (- x1 gap) (+ x2 gap) (- y1 gap) (+ y2 gap))
  )
  ;; dimension position
  (setq xinfs (vl-sort xinfs '(lambda(a b) (< (abs (- (cadr a) (car cpt))) (abs (- (cadr b) (car cpt))))))
        yinfs (vl-sort yinfs '(lambda(a b) (< (abs (- (cadr a) (cadr cpt))) (abs (- (cadr b) (cadr cpt))))))
  )
  (ac-dimInfs xinfs cpt "x")
  (ac-dimInfs yinfs cpt "y")
  ;; dimension angle
  (foreach sEnt sEnts
    (ac-dimAngle sEnt)
  )
  ;; dimension diameter & radius
  (setq newCirPaks (ac-reducePaks cirPaks))
  (setq newArcPaks (ac-reducePaks arcPaks))
  (ac-dimCirArc newCirPaks "cir")
  (ac-dimCirArc newArcPaks "arc")
  (command "UCS" "P")
)

;;;
(defun ac-dimInf(ent / dat typ p1 p2 x1 y1 x2 y2 ang ang2 xs ys xinfs yinfs inf rad sEnt cirPak arcPak)
  (setq dat (entget ent)
        typ (cdr (assoc 0 dat))
  )
  (cond        ((= typ "LINE")
         (setq p1      (trans (cdr (assoc 10 dat)) 0 1)
               p2      (trans (cdr (assoc 11 dat)) 0 1)
               x1 (car p1)
               y1 (cadr p1)
               x2 (car p2)
               y2 (cadr p2)
               ang     (angle p1 p2)
               ang2 (rem ang pi)
               xs      (list x1 x2)
               ys      (list y1 y2)
               sEnt nil
         )
         (cond ((or (equal ang2 0.0 0.01) (equal ang2 pi 0.01) (equal ang2 (* 2.0 pi) 0.01))
                ;; horizontal
                (setq yinfs (list (list (rtos y1 2 4) y1 (list x1 x2)))
                      xinfs nil
                )
               )
               ((or (equal ang2 (* 0.5 pi) 0.01) (equal ang2 (* 1.5 pi) 0.01))
                ;; vertical
                (setq xinfs (list (list (rtos x1 2 4) x1 (list y1 y2)))
                      yinfs nil
                )
               )
               (T
                ;; un-orthogonal
                (setq yinfs (list (list (rtos y1 2 4) y1 (list x1)) (list (rtos y2 2 4) y2 (list x2)))
                      xinfs (list (list (rtos x1 2 4) x1 (list y1)) (list (rtos x2 2 4) x2 (list y2)))
                      sEnt ent
                )
               )
         )
         (setq inf (list xinfs yinfs xs ys sEnt nil nil))
        )
        ((= typ "CIRCLE")
         (setq p1  (trans (cdr (assoc 10 dat)) 0 1)
               x1 (car p1)
               y1 (cadr p1)
               rad (cdr (assoc 40 dat))
               xs  (list (+ x1 rad) (- x1 rad))
               ys  (list (+ y1 rad) (- y1 rad))
               xinfs (list (list (rtos x1 2 4) x1 (list y1)))
               yinfs (list (list (rtos y1 2 4) y1 (list x1)))
               inf (list xinfs yinfs xs ys nil (list p1 rad ent) nil)
         )
        )
        ((= typ "ARC")
         (setq p1 (trans (cdr (assoc 10 dat)) 0 1)
               rad (cdr (assoc 40 dat))
               xs (list (+ (car p1) rad) (- (car p1) rad))
               ys (list (+ (cadr p1) rad) (- (cadr p1) rad))
         )
         (setq inf (list nil nil xs ys nil nil (list p1 rad ent)))
        )
        ((= typ "INSERT")
         (setq p1  (trans (cdr (assoc 10 dat)) 0 1)
               x1 (car p1)
               y1 (cadr p1)
               xs  (list x1)
               ys  (list y1)
               xinfs (list (list (rtos x1 2 4) x1 (list y1)))
               yinfs (list (list (rtos y1 2 4) y1 (list x1)))
               inf (list xinfs yinfs xs ys nil (list p1 rad ent) nil)
         )
        )
  )
  inf
)

;;;
(defun ac-dimPtPair (p1 p2 cpt dir)
  (if (> (distance p1 cpt) (distance p2 cpt))
    (ac-dimOrd p1 (angle p2 p1) cpt dir)
    (ac-dimOrd p2 (angle p1 p2) cpt dir)
  )
)

;;;
(defun ac-dimPtSingle (pt cpt dir / v)
  (setq v (mapcar '- pt cpt))
  (cond        ((= dir "y")
         (if (> (car v) 0.0)
           (ac-dimOrd pt 0.0 cpt dir)
           (ac-dimOrd pt pi cpt dir)
         )
        )
        ((= dir "x")
         (if (> (cadr v) 0.0)
           (ac-dimOrd pt (* 0.5 pi) cpt dir)
           (ac-dimOrd pt (* 1.5 pi) cpt dir)
         )
        )
  )
)

;;;
(defun ac-dimInfs (infs cpt dir / a bs b1 b2 p1 p2)
  (foreach inf infs
    (setq a  (cadr inf)
          bs (vl-sort (nth 2 inf) '<)
    )
    (if        (= (length bs) 1)
      (cond ((= dir "x")
             (setq p1 (list a (car bs) 0.0))
             (ac-dimPtSingle p1 cpt dir)
            )
            ((= dir "y")
             (setq p1 (list (car bs) a 0.0))
             (ac-dimPtSingle p1 cpt dir)
            )
      )
      (cond ((= dir "x")
             (setq p1 (list a (car bs) 0.0)
                   p2 (list a (last bs) 0.0)
             )
             (if (equal p1 p2 1e-5)
               (ac-dimPtSingle p1 cpt dir)
               (ac-dimPtPair p1 p2 cpt dir)
             )
            )
            ((= dir "y")
             (setq p1 (list (car bs) a 0.0)
                   p2 (list (last bs) a 0.0)
             )
             (if (equal p1 p2 1e-5)
               (ac-dimPtSingle p1 cpt dir)
               (ac-dimPtPair p1 p2 cpt dir)
             )
            )
      )
    )
  )
)

;;;
;;; global variables: dd, posRec
;;; stPos: (x1 x2 y1 y2)
(defun ac-dimOrd (pt ang cpt dir / area pp px py dd2 pp2)
  (cond ((or (equal ang 0.0 0.001) (equal ang (* 2.0 pi) 0.001))
         (if (> (cadr pt) (cadr cpt))
           (setq area 7)
           (setq area 6)
         )
        )
        ((equal ang pi 0.001)
         (if (> (cadr pt) (cadr cpt))
           (setq area 5)
           (setq area 4)
         )
        )
        ((equal ang (* 0.5 pi) 0.001)
         (if (> (car pt) (car cpt))
           (setq area 3)
           (setq area 2)
         )
        )
        ((equal ang (* 1.5 pi) 0.001)
         (if (> (car pt) (car cpt))
           (setq area 1)
           (setq area 0)
         )
        )
  )
  (setq pp (nth area posRec))
  (cond        ((= area 0)
         (setq px (car pt)
               py (nth 2 stPos)
         )
         (if pp
           (progn
             (setq dd2 (- (- pp px) dd))
             (if (< dd2 0.0)
               (setq px (+ px dd2))
             )
           )
         )
         (setq pp2 px)
        )
        ((= area 1)
         (setq px (car pt)
               py (nth 2 stPos)
         )
         (if pp
           (progn
             (setq dd2 (- (- px pp) dd))
             (if (< dd2 0.0)
               (setq px (- px dd2))
             )
           )
         )
         (setq pp2 px)
        )
        ((= area 2)
         (setq px (car pt)
               py (nth 3 stPos)
         )
         (if pp
           (progn
             (setq dd2 (- (- pp px) dd))
             (if (< dd2 0.0)
               (setq px (+ px dd2))
             )
           )
         )
         (setq pp2 px)
        )
        ((= area 3)
         (setq px (car pt)
               py (nth 3 stPos)
         )
         (if pp
           (progn
             (setq dd2 (- (- px pp) dd))
             (if (< dd2 0.0)
               (setq px (- px dd2))
             )
           )
         )
         (setq pp2 px)
        )
        ((= area 4)
         (setq px (nth 0 stPos)
               py (cadr pt)
         )
         (if pp
           (progn
             (setq dd2 (- (- pp py) dd))
             (if (< dd2 0.0)
               (setq py (+ py dd2))
             )
           )
         )
         (setq pp2 py)
        )
        ((= area 5)
         (setq px (nth 0 stPos)
               py (cadr pt)
         )
         (if pp
           (progn
             (setq dd2 (- (- py pp) dd))
             (if (< dd2 0.0)
               (setq py (- py dd2))
             )
           )
         )
         (setq pp2 py)
        )
        ((= area 6)
         (setq px (nth 1 stPos)
               py (cadr pt)
         )
         (if pp
           (progn
             (setq dd2 (- (- pp py) dd))
             (if (< dd2 0.0)
               (setq py (+ py dd2))
             )
           )
         )
         (setq pp2 py)
        )
        ((= area 7)
         (setq px (nth 1 stPos)
               py (cadr pt)
         )
         (if pp
           (progn
             (setq dd2 (- (- py pp) dd))
             (if (< dd2 0.0)
               (setq py (- py dd2))
             )
           )
         )
         (setq pp2 py)
        )
  )
  ;; reorder posRec
  (setq        posRec (mapcar '(lambda        (i / r)
                          (if (= i area)
                            (setq r pp2)
                            (setq r (nth i posRec))
                          )
                          r
                        )
                       '(0 1 2 3 4 5 6 7)
               )
  )
  ;; dimension
  (command "DIMORDINATE" "none" pt dir "none" (list px py 0.0))
)

;;; dimension angle
(defun ac-dimAngle (ent / dat p1 p2 sPt ang ang2 ang3 str box v h s dis ePt1 ePt2 tmpPt box1 box2 ss1 ss2 n1 n2 ept)
  (setq        dat (entget ent)
        p1  (trans (cdr (assoc 10 dat)) 0 1)
        p2  (trans (cdr (assoc 11 dat)) 0 1)
        sPt (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
        ang (angle p1 p2)
        ang2 (rem ang pi)
        ang3 (rem ang (/ pi 2.0))
  )
  (if (> ang3 (/ pi 4.0))
    (setq ang3 (- (/ pi 2.0) ang3))
  )
  (setq str (angtos ang3 0)
        str (strcat str "%%d")
        box (textbox (list (cons 1 str)))
        v   (mapcar '(lambda (a b) (- b a)) (car box) (cadr box))
        h   (/ (cadr v) 2.0)
        s   (getvar "DIMSCALE")
  )
  (if (= s 0.0)
    (setq s 1.0)
  )
  (setq        dis   (* s (getvar "DIMTXT") 5))
  (if (> ang2 (/ pi 2.0))
    (setq ePt1        (polar sPt (/ pi 6.0) dis)
          ePt2        (polar sPt (/ (* 7.0 pi) 6.0) dis)
          tmpPt        (list (nth 0 ePt1) (- (nth 1 ePt1) h) (nth 2 ePt1))
          box1        (list tmpPt (mapcar '+ tmpPt v))
          tmpPt        (list (nth 0 ePt2) (+ (nth 1 ePt2) h) (nth 2 ePt2))
          box2        (list (mapcar '- tmpPt v) tmpPt)
    )
    (setq ePt1        (polar sPt (/ (* 5.0 pi) 6.0) dis)
          ePt2        (polar sPt (/ (* 11.0 pi) 6.0) dis)
          tmpPt        (list (nth 0 ePt1) (+ (nth 1 ePt1) h) (nth 2 ePt1))
          box1        (list (mapcar '- tmpPt v) tmpPt)
          tmpPt        (list (nth 0 ePt2) (- (nth 1 ePt2) h) (nth 2 ePt2))
          box2        (list tmpPt (mapcar '+ tmpPt v))
    )
  )
  ;;
  (setq ss1 (ssget "C" (car box1) (cadr box1))
        ss2 (ssget "C" (car box2) (cadr box2))
  )
  (if ss1
    (setq n1 (sslength ss1))
    (setq n1 0)
  )
  (if ss2
    (setq n2 (sslength ss2))
    (setq n2 0)
  )
  (if (<= n1 n2)
    (setq ePt ePt1)
    (setq ePt ePt2)
  )
  ;;
  (command "LEADER" "none" sPt "none" ePt "" str "")
)

;;; dimension diameter & radius
;;;
(defun ac-dimCirArc(paks typ / pt rad ent rads rTxt sym dec dimEnt txtCen txtBox hv p1 p2 ang stAng wAng obj ang1 len)
  (foreach pak paks
    (setq pt  (nth 0 pak)
          rads (nth 1 pak)
          rad (last rads)
          ent (nth 2 pak)
          dec (getvar "DIMDEC")
          rTxt ""
    )
    (if (= typ "cir")
      (setq sym "%%c")
      (setq sym "R")
    )
    (foreach r (reverse (cdr rads))
      (setq rTxt (strcat ", " sym (rtos (* 2.0 r) 2 dec) rTxt))
    )
    (setq rTxt (strcat sym (rtos (* 2.0 (car rads)) 2 dec) rTxt))
    (if (= typ "cir")
      (progn
        (command "DIMDIAMETER" (list ent (polar pt 0.0 rad)) "t" rTxt "none" (polar pt 0.0 rad))
        (setq stAng (/ pi 4.0)
              wAng (+ pi 0.01)
        )
      )
      (progn
        (command "DIMRADIUS" (list ent (polar pt 0.0 rad)) "t" rTxt "none" (polar pt 0.0 rad))
        (setq obj (vlax-ename->vla-object ent)
              ang1 (vla-get-startAngle obj)
              len (vla-get-arcLength obj)
              wAng (/ len rad 2.0)
              stAng (+ ang1 wAng)
        )
      )
    )
    (setq dimEnt (entlast)
          txtCen (trans (cdr (assoc 11 (entget dimEnt))) 0 1)
          txtBox (textbox (list (cons 1 rTxt)))
          hv (mapcar '(lambda(a b) (/ (- b a) 2.0)) (car txtBox) (cadr txtBox))
          p1 (mapcar '- txtCen hv)
          p2 (mapcar '+ txtCen hv)
    )
    (entdel dimEnt)
    (setq ang (ac-findAng pt p1 p2 stAng wAng (/ pi 16.0)))
    (entdel dimEnt)
    (command "ROTATE" dimEnt "" "none" pt (angtos ang))
  )
)

;;;
(defun ac-reducePaks (paks / pt rad ent infs ptStr inf subPaks newPak newPaks)
  (foreach pak paks
    (setq pt (nth 0 pak)
          rad (nth 1 pak)
          ent (nth 2 pak)
          ptStr (strcat (rtos (car pt) 2 4) "," (rtos (cadr pt) 2 4))
          inf (assoc ptStr infs)
    )
    (if inf
      (setq infs (subst (append inf (list pak)) inf infs))
      (setq infs (cons (list ptStr pak) infs))
    )
  )
  (foreach inf infs
    (setq subPaks (vl-sort (cdr inf) '(lambda(a b) (< (cadr a) (cadr b))))
          newPak (list (caar subPaks) (mapcar 'cadr subPaks) (caddr (last subPaks)))
          newPaks (cons newPak newPaks)
    )
  )
  newPaks
)

;;;
(defun ac-findAng (cen p1 p2 stAng wAng dAng / p3 p4 pts ang ck dir ang2 pts2 ss fAng minS)
  (setq        p3  (list (car p1) (cadr p2) 0.0)
        p4  (list (car p2) (cadr p1) 0.0)
        pts (list p1 p3 p2 p4)
        ang 0.0
        ck T
  )
  (while ck
    (setq dir T)
    (repeat 2
      (if ck
        (progn
          (if dir
            (setq ang2 (+ stAng ang))
            (setq ang2 (- stAng ang))
          )
          (setq        pts2 (mapcar '(lambda (a)
                                (ac-newPos a cen ang2)
                              )
                             pts
                     )
                dir  (not dir)
                ss   (ssget "cp" pts2)
          )
          (if ss
            (progn
              (if fAng
                (if (< (sslength ss) minS)
                  (setq        fAng ang2
                        minS (sslength ss)
                  )
                )
                (setq fAng ang2
                      minS (sslength ss)
                )
              )
            ); -progn
            (setq fAng ang2
                  ck nil
            )
          ); -if
        ); -progn
      ); -if
    )
    (if        ck
      (setq ang        (+ ang dAng)
            ck        (<= ang wAng)
      )
    )
  )
  fAng
)

;;;
(defun ac-newPos(pt cen ang / pt2 x1 y1 x2 y2 c s)
  (setq pt2 (mapcar '- pt cen)
        x1 (car pt2)
        y1 (cadr pt2)
        c (cos ang)
        s (sin ang)
        x2 (- (* x1 c) (* y1 s))
        y2 (+ (* x1 s) (* y1 c))
        pt2 (mapcar '+ (list x2 y2 0.0) cen)
  )
  pt2
)
;END

iszc

谢谢分享                 

xxxcondor

hnzkhyyl 发表于 2018-1-14 10:28
自动标注的不好用，很多标注都飞走了

新开一个图就不会了

stonedesign

希望把图框文件发上来，不然没法用的自动图框     tk_h.dwg

南极人

来捧捧场支持

hnzkhyyl

自动标注的不好用，很多标注都飞走了

395969

这个边界和好，如果能做成倾斜的最小面积的的就更好了应该叫ucs吧

心中的梦想

谢谢分享！学习了！！！！！

zhenz02

谢谢楼主的分享

yoyoho

谢谢分享！学习了!!!!!!!!!!!!!!!!!!!!!!!!!!!

灰石Jeremy

哇，厉害厉害~

ketxu

Thanks for sharing and copied and pasted