langjs 发表于 2009-5-5 22:08:00

[原创]标注对齐源程序

本帖最后由 langjs 于 2014-2-8 01:16 编辑

根据网友建议修改更新于2010年12月31日。（网上有个某老大做的尺寸标注对齐的源程序，但是在对齐尺寸时，尺寸界线也发生移动。本人编写了一个尺寸标注对齐的程序，在对齐时候尺寸界线不移动，可能效果好一些，请大家试用。在明经里边学到很多东西，自己也献献丑，做的东西分享给大家。）
坐标的我已经发过一个，请参考http://bbs.mjtd.com/thread-78807-1-1.html

;;; _______________________________________________________;;; 标注对齐   langjs 2011.11.26
;;; (本程序仅适用于多个水平或垂直标注对齐)
;;; _______________________________________________________
(defun c:qq (/ ent i name np10 np11 np13 np14 p0 p00 p10 p11 p13 p14 ss ss1 ss2 u v)
(defun ssgengxin (ss / ent i name p10 p14 ss1 ss2) ; 将误选的横纵标注（少数量）从选择集中删除?
    (setq ss1 (ssadd)ss2 (ssadd))
    (repeat (setq i (sslength ss))
      (setq ent (entget (setq name (ssname ss (setq i (1- i)))))
          p10 (cdr (assoc 10 ent))p14 (cdr (assoc 14 ent))
      )
      (cond
        ((= (fix (+ 0.5 (car p10))) (fix (+ 0.5 (car p14))))
          (setq ss1 (ssadd name ss1))
        )
        ((= (fix (+ 0.5 (cadr p10))) (fix (+ 0.5 (cadr p14))))
          (setq ss2 (ssadd name ss2))
        )
        (t )
      )
    )
    (if (>= (sslength ss1) (sslength ss2))ss1ss2 )
)
(defun jisuan (ent / p10 p11 p13 p14)        ; 计算坐标点子程序
    (setq p10 (cdr (assoc 10 ent))p14 (cdr (assoc 14 ent))
          p11 (cdr (assoc 11 ent))p13 (cdr (assoc 13 ent))
    )
    (cond
      ((= (fix (+ 0.5 (car p10))) (fix (+ 0.5 (car p14))))
        (setq np10 (list (car p10) (cadr p0))
              np11 (list (car p11) (+ (- (cadr p11) (cadr p10)) (cadr p0)))
              np13 (list (car p13) (cadr p00))
              np14 (list (car p14) (cadr p00))
        )
      )
      ((= (fix (+ 0.5 (cadr p10))) (fix (+ 0.5 (cadr p14))))
        (setq np10 (list (car p0) (cadr p10))
              np11 (list (+ (- (car p11) (car p10)) (car p0)) (cadr p11))
              np13 (list (car p00) (cadr p13))
              np14 (list (car p00) (cadr p14))
        )
      )
    )
   )
(defun gengxin (ent u np10 v np11)
    (setq ent (subst(cons u np10)(assoc u ent) ent ))
    (entmod (subst(cons v np11)(assoc v ent) ent ))
)
(setvar "cmdecho" 0)                     ; 关闭命令响应
(if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq ss (ssgengxin ss))
      (if (setq p0 (getpoint "\n指定标注线位置,或<不改变>:"))
        (repeat (setq i (sslength ss))
          (setq ent (entget (ssname ss (setq i (1- i)))))
          (jisuan ent)
          (gengxin ent 10 np10 11 np11)
        )
        (setq p0 '(0.0 0.0))
      )
      (if (setq p00 (getpoint "\n指定引出线位置,或<不改变>:"))
        (repeat (setq i (sslength ss))
          (setq ent (entget (ssname ss (setq i (1- i)))))
          (jisuan ent)
          (gengxin ent 13 np13 14 np14)
        )
      )
    )
)
(princ)
)

578749467 发表于 2010-12-8 07:46:46

真的很好用

alexmai 发表于 2017-10-28 12:53:52

射手座的牛 发表于 2013-1-24 22:30
(defun c:dd ()
(while
(setq pt1 (getpoint "\n指定第一条尺寸界线原点:"))


解决我多年的角度标注的困惑，谢谢你！

笑死蟑 发表于 2009-5-6 08:52:00

<p>學習啦</p><p>好貼</p>

hstea 发表于 2009-5-6 10:02:00

<p>谢谢了。</p>

lhb8121 发表于 2009-5-6 11:11:00

你好,能否开发一个坐标标注对齐的工具,谢谢

cxs259 发表于 2009-5-15 16:15:00

好程序，谢谢

Michael527 发表于 2009-5-18 00:45:00

<p>不错，不用单个进行调整了</p>

xjking007 发表于 2009-10-19 19:37:00

这是好东西呀,高手呀楼主

hnfsf 发表于 2009-11-15 20:49:00

程序写得不错，顶一个，，

hxjxinfuer 发表于 2009-11-16 20:23:00

真的很好用，如果有座标的就更好了。

lz689706 发表于 2009-11-22 13:56:00

<p>赞一个</p>
页: [1] 2 3 4 5 6 7 8 9 10
查看完整版本: [原创]标注对齐源程序