[求助]求一个给已有批量尺寸加前缀%%c的代码

namezg

求一个给已有批量尺寸加前缀%%c的代码

alexmai

jh1005 发表于 2013-6-18 21:46

如果要支持属性块内的文字，如轴号加前缀，应该怎样改？

jh1005

3. (defun c:test (/ ss ent t1 enlst) ;标注或文字前缀加Φ  jh1005
4. (vl-load-com)
5. (while (setq ss (ssget ":S" '((0 . "*TEXT,DIMENSION"))))
6. (setq enlst (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (apply 'append (ssnamex ss))))
7. (foreach ent enlst
8.   (cond
9.    ((or(= (cdr(assoc 0 (entget ent))) "MTEXT")
10.         (= (cdr(assoc 0 (entget ent))) "TEXT"))
11. (setq t1 (vla-get-textstring (vlax-ename->vla-object ent)))
12. (if (not (vl-string-search "%%C" (strcase t1)))
13.       (vla-put-textstring (vlax-ename->vla-object ent) (strcat "%%C" t1))
14.      )
15.    )
16.    ((= (cdr(assoc 0 (entget ent))) "DIMENSION")
17.     (setq t1 (vla-get-textoverride (vlax-ename->vla-object ent)))
18. (if (= t1 "") (setq t1 "<>"))
19. (if (not (vl-string-search "%%C" (strcase t1)))
20.      (vla-put-textoverride (vlax-ename->vla-object ent) (strcat "%%C" t1))
21.      )
22.    )
23.   )
24. )
25. )
26. (princ)
27. )

(defun c:test (/ ss ent t1 enlst) ;标注或文字前缀加Φ  jh1005 (vl-load-com) (while (setq ss (ssget ":S" '((0 . "*TEXT,DIMENSION")))) (setq enlst (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (apply 'append (ssnamex ss)))) (foreach ent enlst   (cond    ((or(= (cdr(assoc 0 (entget ent))) "MTEXT")         (= (cdr(assoc 0 (entget ent))) "TEXT")) (setq t1 (vla-get-textstring (vlax-ename->vla-object ent))) (if (not (vl-string-search "%%C" (strcase t1)))       (vla-put-textstring (vlax-ename->vla-object ent) (strcat "%%C" t1))      )    )    ((= (cdr(assoc 0 (entget ent))) "DIMENSION")     (setq t1 (vla-get-textoverride (vlax-ename->vla-object ent))) (if (= t1 "") (setq t1 "<>")) (if (not (vl-string-search "%%C" (strcase t1)))      (vla-put-textoverride (vlax-ename->vla-object ent) (strcat "%%C" t1))      )    )   ) ) ) (princ) )

yoyoho

程序不错喔!

感谢楼主分享学习!

msh223

jh1005 发表于 2010-9-24 22:50

你好！ 试了一下你写的程序感觉挺实用的，但我一直想要一个 类似的 能批量 给尺寸加 （） 将尺寸括起来。该怎么改呢？

xujinhua

不错啊..谢谢

yshf

修改尺寸样式不行？(注：可不回前后缀)

lzg8877

加后缀的%%Ｄ　能写出来学习下吗　

jh1005

msh223 发表于 2013-6-16 18:22
你好！ 试了一下你写的程序感觉挺实用的，但我一直想要一个 类似的 能批量 给尺寸加 （） 将尺寸括起来。 ...

2. (defun c:kh   (/ ss ent t1 enlst)          ;标注或文字加()
   
3. (princ "\n->标注或文字加()")
   
4. (while (setq ss (ssget ":S" '((0 . "*TEXT,DIMENSION"))))
   
5.   (setq enlst (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (apply 'append (ssnamex ss))))
   
6. (foreach ent enlst
   
7.   (cond
   
8.    ((or(= (cdr(assoc 0 (entget ent))) "MTEXT")
   
9.         (= (cdr(assoc 0 (entget ent))) "TEXT"))
   
10.   (setq t1 (vla-get-textstring (vlax-ename->vla-object ent)))
    
11.     (vla-put-textstring (vlax-ename->vla-object ent) (strcat "(" t1 ")"))
    
12.    )
    
13.    ((= (cdr(assoc 0 (entget ent))) "DIMENSION")
    
14.      ;(vla-put-TextPrefix (en-vla ent) "(")
    
15.   (setq t1 (vla-get-TextOverride (vlax-ename->vla-object ent)))
    
16.   (if (= t1 "") (setq t1 "<>"))
    
17.   (if (and (not (vl-string-search ")" t1)) (not (vl-string-search "(" t1)))
    
18.       (vla-put-TextOverride (vlax-ename->vla-object ent) (strcat "(" t1 ")"))
    
19.      )
    
20.    )
    
21.   )
    
22. )
    
23. (princ (strcat "\n共有" (itoa(sslength ss)) "个对象加上()"))
    
24. )
    
25. (princ)
    
26. )

(defun c:kh   (/ ss ent t1 enlst)          ;标注或文字加()<br /> (princ "\n->标注或文字加()")<br /> (while (setq ss (ssget ":S" '((0 . "*TEXT,DIMENSION"))))<br />   (setq enlst (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (apply 'append (ssnamex ss))))<br /> (foreach ent enlst<br />   (cond<br />    ((or(= (cdr(assoc 0 (entget ent))) "MTEXT")<br />         (= (cdr(assoc 0 (entget ent))) "TEXT"))<br />   (setq t1 (vla-get-textstring (vlax-ename->vla-object ent)))<br />     (vla-put-textstring (vlax-ename->vla-object ent) (strcat "(" t1 ")"))<br />    )<br />    ((= (cdr(assoc 0 (entget ent))) "DIMENSION")<br />      ;(vla-put-TextPrefix (en-vla ent) "(")<br />   (setq t1 (vla-get-TextOverride (vlax-ename->vla-object ent)))<br />   (if (= t1 "") (setq t1 "<>"))<br />   (if (and (not (vl-string-search ")" t1)) (not (vl-string-search "(" t1)))<br />       (vla-put-TextOverride (vlax-ename->vla-object ent) (strcat "(" t1 ")"))<br />      )<br />    )<br />   )<br /> )<br /> (princ (strcat "\n共有" (itoa(sslength ss)) "个对象加上()"))<br /> )<br /> (princ)<br /> )

jh1005

lzg8877 发表于 2013-6-17 06:28
加后缀的%%Ｄ　能写出来学习下吗　

2. (defun c:jd (/ ss ent t1 enlst)            ;标注或文字后缀加°
   
3. (princ "\n->标注或文字后缀加°")
   
4. (while (setq ss (ssget ":S" '((0 . "*TEXT,DIMENSION"))))
   
5. (setq enlst (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (apply 'append (ssnamex ss))))
   
6. (foreach ent enlst
   
7.   (cond
   
8.    ((or(= (cdr(assoc 0 (entget ent))) "MTEXT")
   
9.         (= (cdr(assoc 0 (entget ent))) "TEXT"))
   
10.         (setq t1 (vla-get-textstring (vlax-ename->vla-object ent)))
    
11.         (if (not (vl-string-search "%%D" (strcase t1)))
    
12.        (vla-put-textstring (vlax-ename->vla-object ent) (strcat t1 "%%D"))
    
13.      )
    
14.    )
    
15.    ((= (cdr(assoc 0 (entget ent))) "DIMENSION")
    
16.       (setq t1 (vla-get-TextOverride (vlax-ename->vla-object ent)))
    
17.          (if (= t1 "") (setq t1 "<>"))
    
18.          (if (not (vl-string-search "%%D" (strcase t1)))
    
19.             (vla-put-TextOverride (vlax-ename->vla-object ent) (strcat t1 "%%D"))
    
20.       )
    
21.    )
    
22.   )
    
23. )
    
24. (princ (strcat "\n共有" (itoa(sslength ss)) "个对象后缀加上°"))
    
25. )
    
26. (princ)
    
27. )

(defun c:jd (/ ss ent t1 enlst)            ;标注或文字后缀加°<br /> (princ "\n->标注或文字后缀加°")<br /> (while (setq ss (ssget ":S" '((0 . "*TEXT,DIMENSION"))))<br /> (setq enlst (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (apply 'append (ssnamex ss))))<br /> (foreach ent enlst<br />   (cond<br />    ((or(= (cdr(assoc 0 (entget ent))) "MTEXT")<br />         (= (cdr(assoc 0 (entget ent))) "TEXT"))<br />         (setq t1 (vla-get-textstring (vlax-ename->vla-object ent)))<br />         (if (not (vl-string-search "%%D" (strcase t1)))<br />        (vla-put-textstring (vlax-ename->vla-object ent) (strcat t1 "%%D"))<br />      )<br />    )<br />    ((= (cdr(assoc 0 (entget ent))) "DIMENSION")<br />       (setq t1 (vla-get-TextOverride (vlax-ename->vla-object ent)))<br />          (if (= t1 "") (setq t1 "<>"))<br />          (if (not (vl-string-search "%%D" (strcase t1)))<br />             (vla-put-TextOverride (vlax-ename->vla-object ent) (strcat t1 "%%D"))<br />       )<br />    )<br />   )<br /> )<br /> (princ (strcat "\n共有" (itoa(sslength ss)) "个对象后缀加上°"))<br /> )<br /> (princ)<br /> )

lzg8877

嗯　太好了　学习中