namezg 发表于 2010-9-24 21:07:00

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

<font face="Verdana">求一个给已有批量尺寸加前缀%%c的代码</font>

alexmai 发表于 2017-11-1 20:18:42

本帖最后由 alexmai 于 2017-11-1 20:20 编辑

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

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

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


(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 发表于 2010-9-25 07:11:00

<p>程序不错喔!</p>
<p>感谢楼主分享学习!</p>

msh223 发表于 2013-6-16 18:22:06

jh1005 发表于 2010-9-24 22:50 static/image/common/back.gif


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

xujinhua 发表于 2013-6-16 19:37:37

不错啊..谢谢

yshf 发表于 2013-6-16 21:36:07

本帖最后由 yshf 于 2013-6-16 21:37 编辑

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

lzg8877 发表于 2013-6-17 06:28:43

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

jh1005 发表于 2013-6-18 21:40:03

msh223 发表于 2013-6-16 18:22 static/image/common/back.gif
你好！ 试了一下你写的程序感觉挺实用的，但我一直想要一个 类似的 能批量 给尺寸加 （） 将尺寸括起来。 ...(defun c:kh   (/ ss ent t1 enlst)          ;标注或文字加()
(princ "\n->标注或文字加()")
(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)))
    (vla-put-textstring (vlax-ename->vla-object ent) (strcat "(" t1 ")"))
   )
   ((= (cdr(assoc 0 (entget ent))) "DIMENSION")
   ;(vla-put-TextPrefix (en-vla ent) "(")
(setq t1 (vla-get-TextOverride (vlax-ename->vla-object ent)))
(if (= t1 "") (setq t1 "<>"))
(if (and (not (vl-string-search ")" t1)) (not (vl-string-search "(" t1)))
      (vla-put-TextOverride (vlax-ename->vla-object ent) (strcat "(" t1 ")"))
   )
   )
)
)
(princ (strcat "\n共有" (itoa(sslength ss)) "个对象加上()"))
)
(princ)
)

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

lzg8877 发表于 2013-6-17 06:28 static/image/common/back.gif
加后缀的%%Ｄ　能写出来学习下吗　

(defun c:jd (/ ss ent t1 enlst)            ;标注或文字后缀加°
(princ "\n->标注或文字后缀加°")
(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 "%%D" (strcase t1)))
       (vla-put-textstring (vlax-ename->vla-object ent) (strcat t1 "%%D"))
   )
   )
   ((= (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 "%%D" (strcase t1)))
          (vla-put-TextOverride (vlax-ename->vla-object ent) (strcat t1 "%%D"))
      )
   )
)
)
(princ (strcat "\n共有" (itoa(sslength ss)) "个对象后缀加上°"))
)
(princ)
)

lzg8877 发表于 2013-6-22 06:28:02

嗯　太好了　学习中
页: [1] 2
查看完整版本: [求助]求一个给已有批量尺寸加前缀%%c的代码