标注整理v1.0源程序
本帖最后由 langjs 于 2011-11-26 14:19 编辑编写了一个标注尺寸整理程序，水平标注和垂直标注整理成等距离格式.请各位大虾指点
应网友要求做了个带引出线基点找齐的程序，在20楼。
;;; 《标注整理》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倍
(while (not p0)
(if xuanzeWS01bak
(setq pany xuanzeWS01bak)
(setq xuanzeWS01bak pany)
)
(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)
)
)
(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
((= (fix (+ 0.5 p10x)) (fix (+ 0.5 p14x)))
(if (< p13x p14x)
(setq lst (cons (list name p13x p14x) lst))
(setq lst (cons (list name p14x p13x) lst))
)
)
((= (fix (+ 0.5 p10y)) (fix (+ 0.5 p14y)))
(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) ; 处理垂直标注
(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
)
再加个文字避让就完美了！ 感谢分享~
小工具大作用~ 多謝很實用很好支持 有这个比较方便，顶了 支持一下加个币 强，支持，学习改进 期待这个功能很久了，楼主太给力了！ 先顶一下！~楼主如果可以加上排齐脚点就更好了！~呵呵！~~ 太强大了 请大侠修改下啊。。用于天正标注调整不行哦 flytoday 发表于 2011-11-24 11:24 static/image/common/back.gif
请大侠修改下啊。。用于天正标注调整不行哦
我没安装天正，你把一张天正标注的图纸发到我信箱：59509100@qq.com，我看看能不能改程序