明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1018|回复: 3

[讨论] 如何控制坐标标注的长度(论坛资料)

[复制链接]
发表于 2015-12-13 23:58:03 | 显示全部楼层 |阅读模式
各位大大如何控制一下论坛分享的资料坐标标注的长度啊,,我每次标都跑出去图框了。那个代码是控制他的长度呢。谢谢大神们了



;;;自动坐标标注
(defun C:acc (/ err)
  (command "UNDO" "BE")
  (setq err (vl-catch-all-apply 'ac-autoDim nil))
  (if (vl-catch-all-error-p err)
    (progn
      ;; add some error handles here
    )
  )
  (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 xinf1 yinf1 xinf2 yinf2 cpt gap
                  dd posRec)
  (setq ss (ssget)
        pt (getpoint "\nBase point: ")
        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 xinf1 (nth 0 inf)
              yinf1 (nth 1 inf)
              xs (append (nth 2 inf) xs)
              ys (append (nth 3 inf) ys)
        )
        (if xinf1
          (progn
            (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))
            )
          )
        )
        (if yinf1
          (progn
            (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))
            )
          )
        )
      )
    )
    (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 (* 5.0 dd)
        stPos (list (- x1 gap) (+ x2 gap) (- y1 gap) (+ y2 gap))
  )
  ;; dimension
  (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")
  (command "UCS" "P")
)

;;;
(defun ac-dimInf(ent / dat typ p1 p2 x1 y1 x2 y2 ang ang2 xs ys xinf yinf inf rad)
  (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)
         )
         (cond ((or (equal ang2 0.0 0.01) (equal ang2 pi 0.01) (equal ang2 (* 2.0 pi) 0.01))
                ;; horizontal
                (setq yinf (list (rtos y1 2 4) y1 (list x1 x2)))
               )
               ((or (equal ang2 (* 0.5 pi) 0.01) (equal ang2 (* 1.5 pi) 0.01))
                ;; vertical
                (setq xinf (list (rtos x1 2 4) x1 (list y1 y2)))
               )
         )
         (setq inf (list xinf yinf xs ys))
        )
        ((= 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))
               xinf (list (rtos x1 2 4) x1 (list y1))
               yinf (list (rtos y1 2 4) y1 (list x1))
               inf (list xinf yinf xs ys)
         )
        )
  )
  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)
             )
             (ac-dimPtPair p1 p2 cpt dir)
            )
            ((= dir "y")
             (setq p1 (list (car bs) a 0.0)
                   p2 (list (last bs) a 0.0)
             )
             (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))
)

 楼主| 发表于 2015-12-15 23:55:25 | 显示全部楼层
推一下,大神帮帮忙找一下吧。谢谢!!
 楼主| 发表于 2015-12-17 23:39:34 | 显示全部楼层
大神,,,求帮忙一下吧。。。谢谢了
 楼主| 发表于 2016-1-4 23:54:42 | 显示全部楼层
在推一下,大神幫幫忙吧!謝謝
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-5 19:31 , Processed in 0.201761 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表