cad图块的自动标注定位

byghbcx · 发表于 2012-1-10 10:18:40

刚才的程序第一个command写错了，dimy应改成dimx(command "_dimaligned" pt (list dimx (cadr pt)) (list dimx (- (cadr pt) 10)))

10410024 · 发表于 2012-1-10 12:01:50

byghbcx 发表于 2012-1-10 10:18
刚才的程序第一个command写错了，dimy应改成dimx(command "_dimaligned" pt (list dimx (cadr pt)) (list d ...

你的测试图非常好！。程序我不会改啊，能否重新粘贴一下呢？另外能否将标注移开一定距离，至少不要与块埃在一起，那样就完美了。谢谢！

byghbcx · 发表于 2012-1-10 13:51:33

10410024 发表于 2012-1-10 12:01
你的测试图非常好！。程序我不会改啊，能否重新粘贴一下呢？另外能否将标注移开一定距离，至少不要与块埃 ...

距离与文字的大小要看你的图的尺寸单位，

(defun c:tt( / oldvar lay ss n xlist ylist en pt1 pt2 ang ss1 pt x y xlist1 ylist1 dimx dimy x1 x2 y1 y2)
(command "_.undo" "be")
(setq oldvar (mapcar 'getvar (list "dimdsep" "dimtxt" "dimblk" "osmode")))
(mapcar 'setvar (list "dimdsep" "dimtxt" "dimblk" "osmode") (list "." 5 "_archtick" 0));5为文字的大小
(setq lay (cdr (assoc 8 (entget (car (entsel "\n请选择轴线所在图层:"))))))
(setq ss (ssget "x" (list (cons 0 "line") (cons 8 lay))))
(setq n 0 xlist nil ylist nil)
(if ss
(progn
(repeat (sslength ss)
(setq en (ssname ss n))
(setq pt1 (cdr (assoc 10 (entget en))) pt2 (cdr (assoc 11 (entget en))))
(setq ang (angle pt1 pt2))
(cond ((or (= ang 0) (= ang pi)) (setq ylist (cons (cadr pt1) ylist)))
((or (= ang (* 0.5 pi)) (= ang (* 1.5 pi))) (setq xlist (cons (car pt1) xlist)))
)
(setq n (1+ n))
)
(princ "\n请选择要标注尺寸的图块:")
(setq ss1 (ssget '((0 . "insert"))) n 0)
(if ss1
(progn
(repeat (sslength ss1)
(setq en (ssname ss1 n))
(setq pt (cdr (assoc 10 (entget en))))
(setq x (car pt) y (cadr pt))
(setq xlist1 (vl-sort (cons x xlist) '<))
(cond ((= x (car xlist1)) (setq dimx (cadr xlist1)))
((= x (last xlist1)) (setq dimx (cadr (member x (reverse xlist1)))))
(t (setq x1 (cadr (member x (reverse xlist1))) x2 (cadr (member x xlist1)))
(if (> (- x2 x) (- x x1)) (setq dimx x1) (setq dimx x2))
)
)
(command "_dimaligned" pt (list dimx (cadr pt)) (list dimx (- (cadr pt) 10)));10是偏移的距离
(setq ylist1 (vl-sort (cons y ylist) '<))
(cond ((= y (car ylist1)) (setq dimy (cadr ylist1)))
((= y (last ylist1)) (setq dimy (cadr (member y (reverse ylist1)))))
(t (setq y1 (cadr (member y (reverse ylist1))) y2 (cadr (member y ylist1)))
(if (> (- y2 y) (- y y1)) (setq dimy y1) (setq dimy y2))
)
)
(command "_dimaligned" pt (list (car pt) dimy) (list (- (car pt) 10) dimy));10是偏移的距离
(setq n (1+ n))
)
)
)
)
(princ "\n没有轴线")
)
(mapcar 'setvar (list "dimdsep" "dimtxt" "dimblk" "osmode") oldvar)
(command "_.undo" "e")
)

(defun c:tt( / oldvar lay ss n xlist ylist en pt1 pt2 ang ss1 pt x y xlist1 ylist1 dimx dimy x1 x2 y1 y2) 
  (command "_.undo" "be") 
  (setq oldvar (mapcar 'getvar (list "dimdsep" "dimtxt" "dimblk" "osmode"))) 
  (mapcar 'setvar (list "dimdsep" "dimtxt" "dimblk" "osmode") (list "." 5 "_archtick" 0));5为文字的大小 
  (setq lay (cdr (assoc 8 (entget (car (entsel "\n请选择轴线所在图层:")))))) 
  (setq ss (ssget "x" (list (cons 0 "line") (cons 8 lay)))) 
  (setq n 0 xlist nil ylist nil) 
  (if ss 
    (progn 
      (repeat (sslength ss) 
        (setq en (ssname ss n)) 
        (setq pt1 (cdr (assoc 10 (entget en))) pt2 (cdr (assoc 11 (entget en)))) 
        (setq ang (angle pt1 pt2)) 
        (cond ((or (= ang 0) (= ang pi)) (setq ylist (cons (cadr pt1) ylist))) 
              ((or (= ang (* 0.5 pi)) (= ang (* 1.5 pi))) (setq xlist (cons (car pt1) xlist))) 
              ) 
        (setq n (1+ n)) 
      ) 
      (princ "\n请选择要标注尺寸的图块:") 
      (setq ss1 (ssget '((0 . "insert"))) n 0) 
      (if ss1 
        (progn 
          (repeat (sslength ss1) 
            (setq en (ssname ss1 n)) 
            (setq pt (cdr (assoc 10 (entget en)))) 
            (setq x (car pt) y (cadr pt)) 
            (setq xlist1 (vl-sort (cons x xlist) '<)) 
            (cond ((= x (car xlist1)) (setq dimx (cadr xlist1))) 
                  ((= x (last xlist1)) (setq dimx (cadr (member x (reverse xlist1))))) 
                  (t  (setq x1 (cadr (member x (reverse xlist1))) x2 (cadr (member x xlist1))) 
                      (if (> (- x2 x) (- x x1)) (setq dimx x1) (setq dimx x2)) 
                  ) 
            ) 
            (command "_dimaligned" pt (list dimx (cadr pt)) (list dimx (- (cadr pt) 10)));10是偏移的距离 
            (setq ylist1 (vl-sort (cons y ylist) '<)) 
            (cond ((= y (car ylist1)) (setq dimy (cadr ylist1))) 
                  ((= y (last ylist1)) (setq dimy (cadr (member y (reverse ylist1))))) 
                  (t  (setq y1 (cadr (member y (reverse ylist1))) y2 (cadr (member y ylist1))) 
                      (if (> (- y2 y) (- y y1)) (setq dimy y1) (setq dimy y2)) 
                  ) 
            ) 
            (command "_dimaligned" pt (list (car pt) dimy) (list (- (car pt) 10) dimy));10是偏移的距离 
            (setq n (1+ n)) 
          ) 
          ) 
        ) 
      ) 
    (princ "\n没有轴线") 
    ) 
  (mapcar 'setvar (list "dimdsep" "dimtxt" "dimblk" "osmode") oldvar) 
  (command "_.undo" "e") 
  )

flytoday · 发表于 2012-1-10 21:37:34

本帖最后由 flytoday 于 2012-1-10 21:40 编辑

很好用于桩标注很好~

lgzh0008 · 发表于 2012-1-21 01:39:06

支持一下……

liaoliang317 · 发表于 2013-5-2 09:54:29

确实不错，支持楼主~~~~~~~！

孤单东半球 · 发表于 2013-8-5 22:06:32

值得学习啊

朽木大师 · 发表于 2013-8-15 23:47:46

的确可以用于桩的标注

illcyt · 发表于 2018-6-14 14:11:28

xiaotao 发表于 2012-1-10 05:35
;自己优化一下，碰到多条线时暂不处理
(defun c:1 (/ mid dxf ss-y ss-x MINDIST ss ss1 name pt pt1 dis ...

程序是定位块基点到轴线的距离，但是当块处于两端轴线的中点的时候，这个方向就不会标注，想请教是什么出了问题

Giuly09 · 发表于 2018-6-14 22:07:42

实在是太好了，激起了我努力学习lisp的欲望，，谢谢

账号		自动登录	找回密码
密码			注册