统一字高度和文字样式

自贡黄明儒

;;***改一下，希望更实用*********统一字高 2014.11.11
(defun C:SameHeight (/ E EN N NAME OBJ SS STY TEXTH)
  (cond
    ((and (princ "\n 选择源：")
          (setq e (ssget "_+.:E:S" '((0 . "*TEXT,*DIMENSION"))))
     )
     (setq e (ssname e 0))
     (setq en (entget e))
     (setq Name (cdr (assoc 0 en)))
     (cond ((equal Name "DIMENSION")
            (setq obj (vlax-ename->vla-object e))
            (setq TextH (* (vlax-get obj 'TextHeight) (vlax-get obj 'ScaleFactor)))
           )
           ((wcmatch Name "*TEXT")
            (setq TextH (cdr (assoc 40 en)))
            (setq sty (assoc 7 en))
           )
     )
     (while
       (and (princ "\n 选择目标：") (setq ss (ssget ":S" '((0 . "*TEXT,*DIMENSION")))))
        (repeat        (setq n (sslength ss))
          (setq e (ssname ss (setq n (1- n))))
          (setq en (entget e))
          (setq Name (cdr (assoc 0 en)))
          (cond        ((equal Name "DIMENSION")
                 (setq obj (vlax-ename->vla-object e))
                 (vlax-put obj 'ScaleFactor (/ TextH (vlax-get obj 'TextHeight)))
                )
                ((wcmatch Name "*TEXT")
                 (setq en (entget e))
                 (cond (sty (setq en (subst sty (assoc 7 en) en)))
                       (T (setq sty (assoc 7 en)))
                 )
                 (entmod (subst (cons 40 TextH) (assoc 40 en) en))
                )
          )
        )
     )
    )
  )
  (princ)
)

1. ;;统一字高度和文字样式
   
2. ;;统一字高
   
3. (defun C:w2 (/ E EN N NAME OBJ SCL SS STY TEXTH)
   
4.   (cond   
   
5.     ((and (princ "\n 选择源：")
   
6.           (setq e (ssget "_+.:E:S" '((0 . "*TEXT,*DIMENSION"))))
   
7.      )
   
8.      (setq e (ssname e 0))
   
9.      (setq en (entget e))
   
10.      (setq Name (cdr (assoc 0 en)))
    
11.      (cond ((equal Name "DIMENSION")
    
12.             (setq obj (vlax-ename->vla-object e))
    
13.             (setq sty (vlax-get obj 'TextStyle))
    
14.             (setq scl (vlax-get obj 'ScaleFactor))
    
15.             (setq TextH (vlax-get obj 'TextHeight))
    
16.            )
    
17.            ((wcmatch Name "*TEXT")
    
18.             (setq TextH (cdr (assoc 40 en)))
    
19.             (setq sty (cdr (assoc 7 en)))
    
20.             (setq scl 1)
    
21.            )
    
22.      )     
    
23.      (while (and(princ "\n 选择目标：")(setq ss (ssget ":S" '((0 . "*TEXT,*DIMENSION")))))
    
24.        (repeat (setq n (sslength ss))
    
25.          (setq e (ssname ss (setq n (1- n))))
    
26.          (setq en(entget e))
    
27.          (setq Name (cdr (assoc 0 en)))
    
28.          (cond ((equal Name "DIMENSION")
    
29.                 (setq obj (vlax-ename->vla-object e))
    
30.                 (vlax-put obj 'TextStyle sty)
    
31.                 (vlax-put obj 'TextHeight TextH)
    
32.                 (vlax-put obj 'ScaleFactor scl)
    
33.                )
    
34.                ((wcmatch Name "*TEXT")
    
35.                 (setq en(entget e))
    
36.                 (setq en (subst (cons 7 sty) (assoc 7 en) en))
    
37.                 (entmod (subst (cons 40 (* TextH scl)) (assoc 40 en) en))
    
38.                )
    
39.          )
    
40.        )
    
41.      )
    
42.     )
    
43.   )
    
44.   (princ)
    
45. )
    

;;统一字高度和文字样式<br /> ;;统一字高<br /> (defun C:w2 (/ E EN N NAME OBJ SCL SS STY TEXTH)<br />   (cond    <br />     ((and (princ "\n 选择源：")<br />           (setq e (ssget "_+.:E:S" '((0 . "*TEXT,*DIMENSION"))))<br />      )<br />      (setq e (ssname e 0))<br />      (setq en (entget e))<br />      (setq Name (cdr (assoc 0 en)))<br />      (cond ((equal Name "DIMENSION")<br />             (setq obj (vlax-ename->vla-object e))<br />             (setq sty (vlax-get obj 'TextStyle))<br />             (setq scl (vlax-get obj 'ScaleFactor))<br />             (setq TextH (vlax-get obj 'TextHeight))<br />            )<br />            ((wcmatch Name "*TEXT")<br />             (setq TextH (cdr (assoc 40 en)))<br />             (setq sty (cdr (assoc 7 en)))<br />             (setq scl 1)<br />            )<br />      )     <br />      (while (and(princ "\n 选择目标：")(setq ss (ssget ":S" '((0 . "*TEXT,*DIMENSION")))))<br />        (repeat (setq n (sslength ss))<br />          (setq e (ssname ss (setq n (1- n))))<br />          (setq en(entget e))<br />          (setq Name (cdr (assoc 0 en)))<br />          (cond ((equal Name "DIMENSION")<br />                 (setq obj (vlax-ename->vla-object e))<br />                 (vlax-put obj 'TextStyle sty)<br />                 (vlax-put obj 'TextHeight TextH)<br />                 (vlax-put obj 'ScaleFactor scl)<br />                )<br />                ((wcmatch Name "*TEXT")<br />                 (setq en(entget e))<br />                 (setq en (subst (cons 7 sty) (assoc 7 en) en))<br />                 (entmod (subst (cons 40 (* TextH scl)) (assoc 40 en) en))<br />                )<br />          )<br />        )<br />      )<br />     )<br />   )<br />   (princ)<br /> )<br />

508000096

如果能指定或框选的话就效果会更好。

趣意人生

赞一个，，以后学习学习

999999

赞一个，，以后学习学习

伪书虫86

速度坐个沙发慢慢看

海盗曹

赞一个，学习一下

spp_wall

前排！！！！！！！！！

xiaobaixiaobu

回复看看！！

琴剑江山_10184

好功能，能批量动态修改文字高度不

819534890

呵呵，一直支持源码

yoyoho

赞一个，学习一下!

yiming61

必须看看,学习

wzg356

kkkkkkkkkkkkkk