标注断开和可标注避让有了,请问怎么把他们俩合起来?

hooboxu

都取之于论坛,谢谢大家.一点也不懂LISP.

;;========================================
;; 标注断开+连续标注程序
;; by  明经通道  QQ: 9034598 2009年8月15日
;;========================================
(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
)
;;取值dxf
(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 YAD
(defun yad_dimad1 (SS / yad-dxf yad-perpt yad-chgent ss n m ent en ang w h l_dat l_mov oldang mov s pt pt1 pt2 l_adj en l_en disang disw dish item item1)
  (defun yad-dxf(en n)
    (if (not (listp en)) (setq en (entget en)))
    (cdr (assoc n en))
  )
  (defun yad-perpt(pt pt1 pt2)
    (inters pt1 pt2 pt (polar pt (+ (angle pt1 pt2) (/ pi 2)) 1200) nil)
  )
  (defun yad-chgent(en n / m val)
    (if (not (listp en)) (setq en (entget en)))
    (foreach itm n
      (setq m (car itm) val (cadr itm))
      (if (assoc m en)
        (setq en (subst (cons m val) (assoc m en) en))
        (setq en (append en (list (cons m val))))
      )
    )
    (entmod en)
  )
  ;(prompt "\n选择需要自动调整文字位置的一组标注尺寸：")
  (if SS
    (progn
     ; (vl-cmdf "_undo" "_be")
      (vl-cmdf "_.dimedit" "_h" ss "")
      (setq n -1 m 0)
      (repeat (sslength ss)
        (setq ent (ssname ss (setq n (1+ n))))
        (setq en (yad-dxf (tblsearch "block" (yad-dxf ent 2)) -2))
        (while (/= (yad-dxf (setq en (entnext en)) 0) "MTEXT"))
        (setq ang (yad-dxf en 50) h (yad-dxf en 43) w (+ (/ (yad-dxf en 42) 2) (* 0.2 h)) h (* 0.6 h))
        (setq l_dat (cons (list ent ang w h) l_dat))
        (if (< (/ (yad-dxf ent 42) 2) w)
          (if (= (rem (setq m (1+ m)) 2) 0)
            (setq l_mov (cons (list ent ang w h) l_mov))
            (setq l_mov (append l_mov (list (list ent ang w h))))
          )
        )
      )
      (foreach itm l_mov
        (setq ent (car itm) ang (cadr itm) w (caddr itm) h (cadddr itm) pt (yad-dxf ent 11) oldang (angle pt (yad-perpt pt (setq pt1 (yad-dxf ent 10)) (polar pt1 ang 1200))) mov T)
        (while (and mov (setq s (ssget "_f" (list (setq pt1 (polar (polar pt ang w) (+ ang (/ pi 2)) h)) (setq pt2 (polar pt1 (+ ang pi) (* 2 w))) (setq pt2 (polar pt2 (- ang (/ pi 2)) (* 2 h))) (polar pt2 ang (* 2 w)) pt1)
                                           '((0 . "dimension")(-4 . "<or")(70 . 0)(70 . 1)(70 . 32)(70 . 33)(70 . 128)(70 . 129)(70 . 160)(70 . 161)(-4 . "or>"))
                                )))
          (setq n -1 l_adj nil)
          (repeat (sslength s)
            (setq en (ssname s (setq n (1+ n))))
            (if (and (ssmemb en ss) (not (equal en ent)) (setq l_en (yad-dxf l_dat en)) (equal ang (car l_en) 0.01))
              (progn
                (setq pt1 (yad-perpt (yad-dxf en 11) pt (polar pt ang 1200))
                      disang (angle pt1 pt)
                      disw (- (+ w (cadr l_en)) (distance pt pt1))
                      dish (- (+ h (caddr l_en)) (distance pt (yad-perpt (yad-dxf en 11) pt (polar pt (+ ang (/ pi 2)) 1200))))
                )
                (if (and (> dish 0) (not (equal dish 0 1)))
                  (if (setq item (vl-member-if '(lambda(e) (equal (car e) disang 0.01)) l_adj))
                    (setq item (car item) l_adj (subst (list disang (max disw (cadr item)) (max dish (caddr item))) item l_adj))
                    (setq l_adj (cons (list disang disw dish) l_adj))
                  )
                )
              )
            )
          )
          (cond
            ((not l_adj) (setq mov nil))
            ((and (= (length l_adj) 1) (setq item (car l_adj)) (> (setq disw (cadr item)) 0) (not (equal disw 0 1)) (> (caddr item) 0))
              (if (> (yad-dxf ent 70) 128)
                (progn
                  (setq pt1 (yad-perpt pt (setq pt2 (yad-dxf ent 10)) (polar pt2 ang 1200)))
                  (yad-chgent ent (list (list 11 (setq pt (polar pt (setq disang (angle pt pt1)) (* 2 (+ (distance pt pt1) (if (equal disang oldang 0.01) 0 h)))))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))
                )
                (progn
                  (setq mov nil)
                  (yad-chgent ent (list (list 11 (polar pt (car item) disw)) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))
                )
              )
            )
            ((and (= (length l_adj) 2) (setq item (car l_adj) item1 (cadr l_adj))
                  (or (and (> (setq disw (cadr item)) 0) (not (equal disw 0 1)) (> (caddr item) 0))
                      (and (> (setq disw (cadr item1)) 0) (not (equal disw 0 1)) (> (caddr item1) 0))
                  ))
              (if (or (> (yad-dxf ent 70) 128) (and (> (caddr item) 0) (> (caddr item1) 0) (> (setq disw (+ (cadr item) (cadr item1))) 0) (not (equal disw 0 1))))
                (progn
                  (setq pt1 (yad-perpt pt (setq pt2 (yad-dxf ent 10)) (polar pt2 ang 1200)))
                  (if (equal pt pt1 1) (setq disang (- ang (/ pi 2))) (setq disang (angle pt pt1)))
                  (yad-chgent ent (list (list 11 (setq pt (polar pt disang (* 2 (+ (distance pt pt1) (if (equal disang oldang 0.01) 0 h)))))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))
                )
                (progn
                  (setq mov nil)
                  (if (or (< (caddr item) 0) (and (< (setq disw (cadr item)) 0) (not (equal disw 0 1))))
                    (setq item item1)
                  )
                  (yad-chgent ent (list (list 11 (polar pt (car item) (cadr item))) (list 70 (+ 128 (rem (yad-dxf ent 70) 128)))))
                )
              )
            )
            (T (setq mov nil))
          )
        )
      )
      ;(prompt "\n自动调整完毕！")
     ; (vl-cmdf "_undo" "_e")
    )
  )
  (princ)
)

ZZXXQQ

2. (vl-load-com)
   
3. (defun c:ddr (/ n x ent entL p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd ss1)
   
4. (setvar "cmdecho" 0)
   
5. (command "undo" "be")
   
6. (setq entL '() ss1 (ssadd))
   
7. (if (setq ent (centsel "\n选择标注 或 <退出>:" "DIMENSION")) (progn
   
8.   (ssadd ent ss1);+1
   
9.   (setq x (entget ent)
   
10.         entL (cons ent entL)
    
11.         p2 (dxf 13 x)
    
12.         p3 (dxf 14 x)
    
13.         px1 (list (car p2) (/ (+ (cadr p2)(cadr p3)) 2))
    
14.         px2 (list (car p3) (/ (+ (cadr p2)(cadr p3)) 2))
    
15.         py1 (list (/ (+ (car p2)(car p3)) 2) (cadr p2))
    
16.         py2 (list (/ (+ (car p2)(car p3)) 2) (cadr p3))
    
17.         ptdd (list p2 p3)
    
18.         XL (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
    
19.         SA (abs (sin (angle (dxf 10 xl) (dxf 11 xl)))))
    
20.   (while (setq pt0 (getpoint "\n取点 或 <退出>:"))
    
21.     (command ".copy" ent "" "0,0" "@")
    
22.     (setq entL (cons (entlast) entL))
    
23.     (ssadd (entlast) ss1);+2
    
24.    (cond
    
25.       ((equal SA 1 1e-6) ;;水平
    
26.         (setq ptdd (cons (ptper pt0 px1 px2) ptdd)
    
27.               ppt (Lsort ptdd 0))
    
28.       )
    
29.       ((equal SA 0 1e-6) ;;垂直
    
30.         (setq ptdd (cons (ptper pt0 py1 py2) ptdd)
    
31.               ppt (Lsort ptdd 1))
    
32.       )
    
33.       (t
    
34.          (setq ptdd (cons (ptper pt0 p2 p3) ptdd)
    
35.                ppt (Lsort ptdd 2))
    
36.       )
    
37.     )
    
38.      (setq ppL (mapcar 'list ppt (cdr ppt))
    
39.             n 0)
    
40.      (repeat (length ppL)
    
41.        (setq xf (entget (nth n entL))
    
42.              nxf (subst (cons 13 (car  (nth n ppL)))(assoc 13 xf) xf)
    
43.              wxf (subst (cons 14 (cadr (nth n ppL)))(assoc 14 nxf) nxf)
    
44.              n (1+ n))
    
45.        (entmod wxf)
    
46.      )
    
47.    )
    
48. )
    
49.   (princ "\n退出")
    
50. )
    
51. (yad_dimad1 ss1);+3
    
52. (command "undo" "e") (setvar "cmdecho" 1)
    
53. (princ)
    
54. )
    
55. (defun centsel (msg f)
    
56. (while (if (setq el (car (entsel msg))) (if (= (cdr (assoc 0 (entget el))) f) nil t) nil))
    
57. el
    
58. )
    
59. ;;取值dxf
    
60. (defun dxf (x e)(cdr (assoc x e)))
    
61. ;;求垂足
    
62. (defun ptper (pt0 pt1 pt2)
    
63. (inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)
    
64. )
    
65. ;;排序 0 水平 1 垂直 2 倾斜
    
66. (defun Lsort (LT i)
    
67. (cond
    
68. ((or (= i 0)(= i 2))(setq Lt (vl-sort LT '(lambda (e1 e2)(< (car e1) (car e2))))))
    
69. ((or (= i 1)(= i 2))(setq Lt (vl-sort LT '(lambda (e1 e2)(< (cadr e1) (cadr e2))))))
    
70. )
    
71. )
    
72. (princ)
    

(vl-load-com)<br /> (defun c:ddr (/ n x ent entL p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd ss1)<br /> (setvar "cmdecho" 0)<br /> (command "undo" "be")<br /> (setq entL '() ss1 (ssadd))<br /> (if (setq ent (centsel "\n选择标注 或 <退出>:" "DIMENSION")) (progn<br />   (ssadd ent ss1);+1<br />   (setq x (entget ent)<br />         entL (cons ent entL)<br />         p2 (dxf 13 x)<br />         p3 (dxf 14 x)<br />         px1 (list (car p2) (/ (+ (cadr p2)(cadr p3)) 2))<br />         px2 (list (car p3) (/ (+ (cadr p2)(cadr p3)) 2))<br />         py1 (list (/ (+ (car p2)(car p3)) 2) (cadr p2))<br />         py2 (list (/ (+ (car p2)(car p3)) 2) (cadr p3))<br />         ptdd (list p2 p3)<br />         XL (entget (dxf -2 (tblsearch "block" (dxf 2 x))))<br />         SA (abs (sin (angle (dxf 10 xl) (dxf 11 xl)))))<br />   (while (setq pt0 (getpoint "\n取点 或 <退出>:"))<br />     (command ".copy" ent "" "0,0" "@")<br />     (setq entL (cons (entlast) entL))<br />     (ssadd (entlast) ss1);+2<br />    (cond<br />       ((equal SA 1 1e-6) ;;水平<br />         (setq ptdd (cons (ptper pt0 px1 px2) ptdd)<br />               ppt (Lsort ptdd 0))<br />       )<br />       ((equal SA 0 1e-6) ;;垂直<br />         (setq ptdd (cons (ptper pt0 py1 py2) ptdd)<br />               ppt (Lsort ptdd 1))<br />       )<br />       (t<br />          (setq ptdd (cons (ptper pt0 p2 p3) ptdd)<br />                ppt (Lsort ptdd 2))<br />       )<br />     )<br />      (setq ppL (mapcar 'list ppt (cdr ppt))<br />             n 0)<br />      (repeat (length ppL)<br />        (setq xf (entget (nth n entL))<br />              nxf (subst (cons 13 (car  (nth n ppL)))(assoc 13 xf) xf)<br />              wxf (subst (cons 14 (cadr (nth n ppL)))(assoc 14 nxf) nxf)<br />              n (1+ n))<br />        (entmod wxf)<br />      )<br />    )<br /> )<br />   (princ "\n退出")<br /> )<br /> (yad_dimad1 ss1);+3<br /> (command "undo" "e") (setvar "cmdecho" 1)<br /> (princ)<br /> )<br /> (defun centsel (msg f)<br /> (while (if (setq el (car (entsel msg))) (if (= (cdr (assoc 0 (entget el))) f) nil t) nil))<br /> el<br /> )<br /> ;;取值dxf<br /> (defun dxf (x e)(cdr (assoc x e)))<br /> ;;求垂足<br /> (defun ptper (pt0 pt1 pt2)<br /> (inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)<br /> )<br /> ;;排序 0 水平 1 垂直 2 倾斜<br /> (defun Lsort (LT i)<br /> (cond<br /> ((or (= i 0)(= i 2))(setq Lt (vl-sort LT '(lambda (e1 e2)(< (car e1) (car e2))))))<br /> ((or (= i 1)(= i 2))(setq Lt (vl-sort LT '(lambda (e1 e2)(< (cadr e1) (cadr e2))))))<br /> )<br /> )<br /> (princ)<br />

hooboxu

先谢谢楼上的大大，我去试试

chanyuyee

这个标注文字避让是跟天正那样的吗？

shijiacong

ZZXXQQ 发表于 2014-7-24 20:58

请问为什么我用不了。。