图框文字批量修改。

millermin

叮咚 发表于 2012-12-24 21:26
我以前用的时候，就是按照他文档中的说明做的。 我的xp系统能用的。

以前做过一个程序，不开图关闭指定层。这回仅仅将中间对层的操作更换更改图元，头尾都一样。但是老程序在xp win7 都能运行，但这个新做的程序就是无法成功存盘。也不给个错误提示，跟踪过程也无异样，无法下手差错。

yansu

就是希望有一个程序能不打开图纸，选定同目录下的有用图纸的标题栏图块（或图框）中的页码属性文字进行递增修改，形成一套有完整页码的图纸。在以后增加或减少图纸是，再重新运行程序进行页码编排，形成新的页码。谢谢。

millermin

问题终于在SANTA来我家送礼物前解决了。初稿，使用的是群码查找修改数据，这对于dbx对象并无改变，所以存盘无变化。后来读程序是发现不对劲，文件的打开关闭形式都是dbx，而中间的处理过程却是autocad的群码方式，感觉“不对称”。所以今天索性将中间处理部分也改用了dbx对象处理技术。如此前后都一致了。结果一次成功。
再次感谢朋友们的帮忙。祝朋友们圣诞快乐。

yansu

楼主能否分享一下，谢谢

millermin

yansu 发表于 2012-12-26 08:22
楼主能否分享一下，谢谢

ok.
仅仅是一个方法，因为具体数据和公司要求有关，没有通用性。

(defun c:sht()
(vl-load-com)
(setvar "cmdecho" 0)

(setq a (getint "\nENTER THE DIFFERENCE OF SHEET NUMBER:"))
(setq dwgfile (getfiled "Select a drawing" "" "dwg" 0))

(setq cadver(substr (getvar "acadver") 1 2))                     
(setq id (strcat "objectdbx.AxDbDocument." cadver))           
(setq dbx(vlax-create-object id))                                         

  (vla-open dbx dwgfile)
  (setq pspace (vla-get-paperspace dbx))

  (vlax-for obj pspace
     (if (and  (= (setq lay (vla-get-layer obj)) "BORDER")
               (= (setq id  (vla-get-objectname obj)) "AcDbText")
               (= (setq sty (vla-get-stylename obj)) "ROMANS")
               (= (setq col (vla-get-color obj)) 4)
         )
         (progn
          (setq shtno-old (vla-get-textstring obj))  
          (setq shtno-new (itoa (+ (atoi shtno-old) a)))
          (vla-put-textstring obj shtno-new)
         )   
      )
  )
  (vla-saveas dbx dwgfile)   
  
(vlax-release-object dbx)
(princ)
)