标注整理v1.0源程序

13579

楼主给力！

czb203

顶你了 很不错的标注插件正需要呢谢谢哈

仲文玉

支持一下加个币

無恒的地盘

好像基点没有对齐功能

langjs

無恒的地盘 发表于 2011-11-25 21:15
好像基点没有对齐功能

我发过一个“标注对齐”程序，里边有基点找齐功能。

lidaxiu

(princ (strcat "\n指定尺寸偏移起点，或[当前尺寸间距<" (rtos pany 2 1) ">，重新设置(S)]:"))
感觉 pany值的设置应当与dimscale成倍数关系，这样就不用每换次标注样式就得重新设置了！！！

langjs

lidaxiu 发表于 2011-11-25 23:34
(princ (strcat "\n指定尺寸偏移起点，或[当前尺寸间距，重新设置(S)]:"))
感觉 pany值的设置应当与dimsca ...

(setq pany (* (+ zhigao pan) bili 1.5)) ; 此处设置“默认尺寸间距”为字高加偏移的1.5倍
比例已经算进去了

無恒的地盘

我知道楼主已前有一个标注对齐，不过有时好像有点问题，有时执行不了
我觉现在这个也很好用，希望加上一个基点对齐，谢谢

LLL2011

很好，不要动不动就收币，分享源码的就支持！！！顶你！！！

langjs

無恒的地盘 发表于 2011-11-25 21:15
好像基点没有对齐功能

修改了一下，带基点对齐的程序在这里
;;; 　　　      《标注整理》v1.0
;;; ============================================
;;; 功能：水平标注和垂直标注整理成等距离格式，
;;;       带引出线脚点对齐
;;;       命令：BZZL
;;; 作者：langjs qq:59509100 日期:2011年11月21日
;;; ============================================
(defun C:BZZL (/ bili ent hlst i lst name p0 p10 p10x p10y p13 p13x p13y p14 p14x p14y pan pany shezi ss uu vv zhigao)
  (setvar "cmdecho" 0)
  (command ".UNDO" "BE")
  (setq ss (ssget '((0 . "DIMENSION"))))
  (setq ss (ssgengxin ss))
  (setq zhigao (getvar "DIMTXT")
        pan (getvar "DIMGAP")
        bili (getvar "DIMSCALE")
  )
  (setq pany (* (+ zhigao pan) bili 1.5)) ; 此处设置“默认尺寸间距”为字高加偏移的1.5倍
  (if xuanzeWS01bak
    (setq pany xuanzeWS01bak)
    (setq xuanzeWS01bak pany)
  )
  (setq shezi "S")
  (while (= shezi "S")
    (initget "S ")
    (princ (strcat "\n指定尺寸偏移起点，或<不改变>：[当前尺寸间距<" (rtos pany 2 1) ">重新设置(S)]"))
    (setq shezi (getpoint ""))
    (if (= shezi "S")
      (progn
        (setq pany (getreal (strcat "\n设置尺寸间距：<" (rtos pany 2 1) ">")))
        (setq xuanzeWS01bak pany)
      )
      (setq p0 shezi)
    )
  )
  (if (/= P0 nil)
    (progn
      (setq lst '()
            Hlst '()
      )
      (repeat (setq i (sslength ss))
        (setq name (ssname ss (setq i (1- i))))
        (setq ent (entget name))
        (setq p10 (cdr (assoc 10 ent))
              p13 (cdr (assoc 13 ent))
              p14 (cdr (assoc 14 ent))
        )
        (setq p10x (car p10)
              p10y (cadr p10)
              p13x (car p13)
              p13y (cadr p13)
              p14x (car p14)
              p14y (cadr p14)
        )
        (cond
          ((= (sswr p10x 1) (sswr p14x 1))
            (if (< p13x p14x)
              (setq lst (cons (list name p13x p14x) lst))
              (setq lst (cons (list name p14x p13x) lst))
            )
          )
          ((= (sswr p10y 1) (sswr p14y 1))
            (if (< p13y p14y)
              (setq Hlst (cons (list name p13y p14y) Hlst))
              (setq Hlst (cons (list name p14y p13y) Hlst))
            )
          )
          (t
            (princ)
          )
        )
      )
      (setq uu 0
            vv 1
      )
      (biaozhu lst p0 uu vv pany)      ; 处理水平标注
      (setq uu 1
            vv 0
      )
      (biaozhu Hlst p0 uu vv pany)
    )
  )                                       ; 处理垂直标注
  (setq p00 (getpoint "\n指定引出线位置，或<不改变>："))
  (if p00
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i))))
      (setq ent (entget ent))
      (jisuanshuju01 ent p00)
      (gengxinchichunjiexian01 ent np13 np14)
    )
    (princ)
  )
  (command ".UNDO" "E")
  (princ)
)
;;; 计算坐标点，尺寸更新到合适位置子函数
(defun biaozhu (lst p0 uu vv pany / chansu dim1 ent fuh fuh1 i j lst02 n name p0x p0y p10 p10x p10y p11 p11x p11y p13 p13x p13y p14
                    p14x p14y pmax pmin
               )
  (setq n 1)
  (while (> (length lst) 0)
    (setq i 0
          p0x (car p0)
          p0y (cadr p0)
    )
    (setq j 0
          lst02 '()
    )
    (while (< j (length lst))
      (setq lst02 (cons (nth j lst) lst02))
      (setq j (1+ j))
    )
    (setq lst02 (reverse lst02))
    (while (< i (length lst))
      (setq dim1 (nth i lst))
      (setq i (1+ i))
      (setq name (car dim1)
            pmin (cadr dim1)
            pmax (caddr dim1)
      )
      (setq chansu (baohan dim1 lst))
      (if (or
            (= chansu "F")
            (= chansu "Y")
          )
        (progn
          (setq ent (entget name))
          (setq p10 (cdr (assoc 10 ent))
                p11 (cdr (assoc 11 ent))
                p13 (cdr (assoc 13 ent))
                p14 (cdr (assoc 14 ent))
          )
          (setq p10x (car p10)
                p10y (cadr p10)
                p11x (car p11)
                p11y (cadr p11)
                p13x (car p13)
                p13y (cadr p13)
                p14x (car p14)
                p14y (cadr p14)
          )
          (if (> p10y p13y)
            (setq fuh 1)
            (setq fuh -1)
          )
          (if (> p10x p13x)
            (setq fuh1 1)
            (setq fuh1 -1)
          )
          (setq p10 (list (+ (* vv p10x) (* uu p0x) (* uu (* fuh1 (* n pany)))) (+ (* uu p10y) (* vv p0y) (* vv (* fuh (* n pany))))))
          (setq p11 (list (+ (* vv p11x) (* uu p0x) (* uu (* fuh1 (* n pany)))) (+ (* uu p11y) (* vv p0y) (* vv (* fuh (* n pany)))))) ;    (setq p1 (list (+ p0x (* uu (* fuh1 (* n pany)))) (+ p0y (* vv (* fuh (* n pany))))
          (setq lst02 (vl-remove dim1 lst02))
          (if (= chansu "Y")
            (setq n (1+ n))
          )
          (setq ent (subst
                      (cons 10 p10)
                      (assoc 10 ent)
                      ent
                    )
          )
          (setq ent (subst
                      (cons 11 p11)
                      (assoc 11 ent)
                      ent
                    )
          )
          (entmod ent)
        )
      )
    )
    (setq n (1+ n))
    (setq lst lst02)
  )
  (princ)
)
;;; 判断某个尺寸范围内是否有其它尺寸子函数
(defun baohan (dim1 lst / chansu dim2 i name name01 pmax pmax01 pmin pmin01)
  (setq name (car dim1)
        pmin (cadr dim1)
        pmax (caddr dim1)
        chansu "F"
        i 0
  )
  (while (and
           (< i (length lst))
           (/= chansu "Y")
         )
    (setq name01 (car (nth i lst))
          pmin01 (cadr (nth i lst))
          pmax01 (caddr (nth i lst))
          dim2 (nth i lst)
    )
    (setq i (1+ i))
    (if (or
          (and
            (<= (sswr pmin 1) (sswr pmin01 1))
            (< (sswr pmax01 1) (sswr pmax 1))
          )
          (and
            (< (sswr pmin 1) (sswr pmin01 1))
            (<= (sswr pmax01 1) (sswr pmax 1))
          )
        )
      (setq chansu "T")
    )
    (if (or
          (and
            (< (sswr pmin 1) (sswr pmin01 1))
            (< (sswr pmax 1) (sswr pmax01 1))
            (< (sswr pmin01 1) (sswr pmax 1))
          )
          (and
            (< (sswr pmin01 1) (sswr pmin 1))
            (< (sswr pmax01 1) (sswr pmax 1))
            (< (sswr pmin 1) (sswr pmax01 1))
          )
        )
      (setq chansu "Y")
    )
  )
  chansu
)
;;; 将误选的横纵标注（少数量）从选择集中删除子函数
(defun ssgengxin (ss / ent i name p10 p10x p10y p14 p14x p14y ss1 ss2)
  (setq ss1 (ssadd)
        ss2 (ssadd)
  )
  (repeat (setq i (sslength ss))
    (setq name (ssname ss (setq i (1- i))))
    (setq ent (entget name))
    (setq p10 (cdr (assoc 10 ent))
          p14 (cdr (assoc 14 ent))
    )
    (setq p10x (car p10)
          p10y (cadr p10)
          p14x (car p14)
          p14y (cadr p14)
    )
    (cond
      ((= (fix (+ 0.5 p10x)) (fix (+ 0.5 p14x)))
        (setq ss1 (ssadd name ss1))
      )
      ((= (fix (+ 0.5 p10y)) (fix (+ 0.5 p14y)))
        (setq ss2 (ssadd name ss2))
      )
      (t
        (princ)
      )
    )
  )
  (if (>= (sslength ss1) (sslength ss2))
    (setq ss ss1)
    (setq ss ss2)
  )
  ss
)
;;; 四舍五入函数，ent:实数，n：小数点保留位数
(defun sswr (ent n / fh)
  (if (>= ent 0.0)
    (setq fh +)
    (setq fh -)
  )
  (setq ent (/ (atof (itoa (fix (fh (* ent (expt 10 n)) 0.5)))) (expt 10 n)))
  ent
)
(defun jisuanshuju01 (ent p00 / p00x p00y p0x p0y p10 p10x p10y p11 p11x p11y p13 p13x p13y p14 p14x p14y) ; 计算坐标点子程序
  (setq p00x (car p00)
        p00y (cadr p00)
  )                                       ; 取得标注各关键坐标点值
  (setq p10 (cdr (assoc 10 ent))
        p14 (cdr (assoc 14 ent))
        p11 (cdr (assoc 11 ent))
        p13 (cdr (assoc 13 ent))
  )
  (setq p10x (car p10)
        p10y (cadr p10)
        p14x (car p14)
        p14y (cadr p14)
        p11x (car p11)
        p11y (cadr p11)
        p13x (car p13)
        p13y (cadr p13)
  )                                       ; 判断横、纵坐标并计算对齐后的关键标注坐标点值
  (cond
    ((= (fix (+ 0.5 p10x)) (fix (+ 0.5 p14x)))
      (setq np13 (list p13x p00y 0.0)
            np14 (list p14x p00y 0.0)
      )
    )
    ((= (fix (+ 0.5 p10y)) (fix (+ 0.5 p14y)))
      (setq np13 (list p00x p13y 0.0)
            np14 (list p00x p14y 0.0)
      )
    )
    (t
      (exit)
    )
  )
  (princ)
)
(defun gengxinchichunjiexian01 (ent np13 np14) ; 对齐引出线子程序
  (setq ent (subst
              (cons 13 np13)
              (assoc 13 ent)
              ent
            )
  )
  (setq ent (subst
              (cons 14 np14)
              (assoc 14 ent)
              ent
            )
  )
  (entmod ent)
  (princ)
)