求制作多级标注工具

xj6019

    可不可以标注的时候直接出多级标注，运行命令后可以输入数值确定几级标注，因为有时候复杂的图形可能需要拉三四排尺寸的
打个比方 一次标三排的情况下   第二排是不好确定点位的，可以设置成第一排逐点标注，第二三排都是出总长
然后第二排用尺寸断开工具 再断开分布开  断开工具我手头有，需要参考的话 我就提供，最好合并进去   然后可以循环   循环是用于三排以上的时候
两层标注之间的偏移量读取当前标注样式的全局比例，1:1情况下的偏移量为6 不要出现输入确定   需要更改的话直接改代码就行，因为这个量基本不变

表达能力有限，高手们能看明白表述吧，期待有伟大的作品产生，谢谢！！

start4444

xj6019 发表于 2019-12-9 18:32
非常谢谢您的回复！！
1.标注的梯级之间要留个空隙。
2.直接用固定的间距 不行哦  比方说详图用5倍的标 ...

加上排距，分隔和拆分代码

start4444

标注每层间隔1000，不行自己调吧

xj6019

start4444 发表于 2019-12-9 14:43
标注每层间隔1000，不行自己调吧

非常谢谢您的回复！！
1.标注的梯级之间要留个空隙。
2.直接用固定的间距 不行哦  比方说详图用5倍的标注，再画大的平面图就要用30倍的标注，倍数之间经常切换的，总不能老是去改代码呀，麻烦您可以给弄弄按标注样式的比例来确定标注线直接的距离吗，拜托了！！

如果标注断开没法加进去，以上两个我还是希望可以满足的，尤其是比例方面的问题，麻烦您了！！

xj6019

start4444 发表于 2019-12-9 14:43
标注每层间隔1000，不行自己调吧

这个代码是明经上的，出自哪里忘了 ，先对作者表示感谢和抱歉！挪用一下！
其中命令ddr可以断开标注，合并的ddc命令直接忽略删掉就行，麻烦您可以直接加进去吗，拜托了！！
(vl-load-com)
(defun c:ddr (/ n x ent entL p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq entL '())
(if (setq ent (centsel "\n選擇標注 或 <退出>:" "DIMENSION"))
   (progn
     (setq x (entget ent)
        entL (cons ent entL)
          p2 (dxf 13 x)
          p3 (dxf 14 x)
          px1 (list (car p2) (/ (+ (cadr p2)(cadr p3)) 2.0))
          px2 (list (car p3) (/ (+ (cadr p2)(cadr p3)) 2.0))
          py1 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p2))
          py2 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p3))
          ptdd (list p2 p3)
          XL (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
          SA (abs (sin (angle (dxf 10 xl) (dxf 11 xl)))))
   (while (setq pt0 (getpoint "\n取点 或 <退出>:"))
       (command ".copy" ent "" "0,0" "@")
       (setq entL (cons (entlast) entL))
    (cond
      ((equal SA 1 1e-6) ;;水平
         (setq ptdd (cons (ptper pt0 px1 px2) ptdd)
                 ppt (Lsort ptdd 0))
        )
      ((equal SA 0 1e-6) ;;垂直
         (setq ptdd (cons (ptper pt0 py1 py2) ptdd)
                ppt (Lsort ptdd 1))
       )
       (t (setq ptdd (cons (ptper pt0 p2 p3) ptdd)
            ppt (Lsort ptdd 2)))
      )
       (setq ppL (mapcar 'list ppt (cdr ppt))
              n 0)
         (repeat (length ppL)
           (setq xf (entget (nth n entL))
                nxf (subst (cons 13 (car  (nth n ppL)))(assoc 13 xf) xf)
                wxf (subst (cons 14 (cadr (nth n ppL)))(assoc 14 nxf) nxf)
                n (1+ n))
           (entmod wxf)
         )
     ))
  (princ "\n退出")
)
  (command "undo" "e") (setvar "cmdecho" 1)
  (princ)
)

(defun centsel (msg f)
(while (if (setq el (car (entsel msg))) (if (= (cdr (assoc 0 (entget el))) f) nil t) nil)) el
)

(defun dxf (x e)(cdr (assoc x e)))
;;求垂足
(defun ptper (pt0 pt1 pt2)
(inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)
)
;;排序 0 水平 1 垂直 2 ?斜
(defun Lsort (LT i)
(cond
((or (= i 0)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (car e1) (car e2)))))))
((or (= i 1)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))))
))

(princ)


;;========================================
;; ?注合并程序
;; by  明?通道  QQ: 9034598 2013年6月30日
;;========================================
(defun c:ddc( / ss ic xic aa bb n ent1)
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n選擇要合併的標注")
(setq ss (ssget '((0 . "DIMENSION")))
      sumn (sslength ss) n 0 xss '() aa '())
(repeat sumn (setq xss (cons (ssname ss n) xss) n (1+ n))) ;;??集改表
(while (car xss)
  (setq bb '()
        bb (cons (car xss) bb)
        ic (getxx (entget (car xss)))
        xss (cdr xss)
        yss xss)
  (while (car yss)
    (setq ent1 (car yss)
           xic (getxx (entget ent1)))
     (if (apply 'and (mapcar '(lambda(x y)(equal x y 1e-5)) xic ic))
         (setq bb (cons ent1 bb)
              xss (vl-remove ent1 xss)))
         (setq yss (cdr yss)))
   (setq aa (cons bb aa))
)
(setq n 0)
(repeat (length aa)
  (setq ent1 (nth n aa) n (1+ n))
  (if (cdr ent1)(progn
    (setq ptx (getmxy ent1)
          xf (entget (car ent1))
         nxf (subst (cons 13 (car  ptx))(assoc 13 xf) xf)
         wxf (subst (cons 14 (cadr ptx))(assoc 14 nxf) nxf)
          xx (cdr ent1))
    (entmod wxf)
    (while xx (entdel (car xx)) (setq xx (cdr xx)))
  ))
)
(command "undo" "e") (setvar "cmdecho" 1)
(princ)
)
(defun dxf (x e)(cdr (assoc x e)))
(defun getxx(x / xy xl a b bb)
(setq xy (dxf 10 x)
      xl (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
       A (angle (dxf 10 xl) (dxf 11 xl)))
(cond
   ((equal (abs (sin A)) 1 1e-6) ;;水平
      (list (cadr xy) (sin A)))
   ((equal (sin A) 0 1e-6) ;;垂直
      (list (car xy) (sin A)))
   (t (setq B (+ A (* 0.5 pi))
           bb (- (cadr xy) (* (/ (sin B)(cos B)) (car xy))))
      (list bb (sin A)))
  )
)
(defun getmxy(ssent / ptx xx yy)
(foreach x ssent
    (setq ptx (cons (dxf 13 (entget x)) ptx)
          ptx (cons (dxf 14 (entget x)) ptx)))
(setq xl (entget (dxf -2 (tblsearch "block" (dxf 2 (entget (car ssent))))))
       A (angle (dxf 10 xl) (dxf 11 xl)))
(cond
      ((equal SA 1 1e-6) (setq ppt (Lsort ptx 0)))
      ((equal SA 0 1e-6) (setq ppt (Lsort ptx 1)))
       (t (setq ppt (Lsort ptx 2)))
  )(list (car ppt)(last ppt))
)

(defun Lsort (LT i)
(cond
((or (= i 0)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (car e1) (car e2)))))))
((or (= i 1)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))))
))
(princ)

依然小小鸟

不错的帖子顶一下

xj6019

start4444 发表于 2019-12-9 09:26
加上排距，分隔和拆分代码

再次表示感谢！！
还有几点需要改进的再麻烦最后一次好吗！！
1.输入的排数和间距能记忆上次的数值，麻烦加一下好吗 ，断开的时候还不能循环是吧，好改吗？
2.遇到第一排标注点不是水平或者垂直的时候标出来的是斜的，能麻烦您给加个判断行吗！希望能通用于水平/垂直/斜边的标注 自动判断或者加个按键锁定方向也行
3.断开寸法的代码看看可以改一下，改成dco 那种标注的效果吗，因为现在断开后调整尺寸的时候如果位置和之前不是一齐的话
一拉动尺寸线就跑了。其实就是断开的时候参照你的第一排逐点标注的样式。

再次拜托了，谢谢，最后一次，再麻烦您最后一次了！！

start4444

xj6019 发表于 2019-12-10 08:52
再次表示感谢！！
还有几点需要改进的再麻烦最后一次好吗！！
1.输入的排数和间距能记忆上次的数值，麻 ...

你这样的操作只能用线性标注，但是不能标斜的。

xj6019

start4444 发表于 2019-12-10 16:00
你这样的操作只能用线性标注，但是不能标斜的。

试用了一下，算是很好了，后续我再学习一下你的代码，希望使用中可以自己调整变动，明经的大神们还有更好的想法或者建议也请给优化一下，我暂时能想到的就这么多了
再次感谢您的耐心解答，又帮我解决了一个难题，非常感谢，非常感谢！！

xj6019

start4444 发表于 2019-12-10 16:00
你这样的操作只能用线性标注，但是不能标斜的。

方便的话这这个基础上，给我弄个标注斜边的行吗，不行就用两个命令吧，我自己试着改了一下，水平不行啊，运行不了，谢谢