[教学]：一个用 ObjectDBX 批量修改图形特定内容的程序

eachy · 发表于 2006-4-9 15:42:37

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(vl-load-com)
;; for Windows XP / winnt2k
;; (xdl-getfiles) 选取多个文件，返回目录文件列表
(defun xdl-getfiles (/ initdir maxfs flags diatl filter wincomdlg filem
fstr->lst)
(defun fstr->lst (fm / n ff)
(setq ff nil)
(if (vl-string-position (ascii "\000") fm)
(progn
(while (vl-string-position (ascii "\000") fm)
(setq n (vl-string-position (ascii "\000") fm))
(setq ff (append ff (list (substr fm 1 n))))
(setq fm (substr fm (+ n 2) (- (strlen fm) n 1)))
)
(setq ff (append ff (list fm)))
)
(progn
(setq ff (vl-filename-directory fm))
(setq ff (list ff (vl-string-subst "" ff fm)))
)
)
)
(setq initdir (getvar "dwgprefix"))
(if
(not
(vl-registry-read
"HKEY_CLASSES_ROOT\\CLSID\\{7629CFA2-3FE5-101B-A3C9-08002B2F49FB}\\InprocServer32"
)
)
(progn
(princ
"\n第一次运行需要注册控件,程序自动注册,请重新启动系统"
)
(VL-REGISTRY-WRITE
"HKEY_CLASSES_ROOT\\Licenses\\{4D553650-6ABE-11CF-8ADB-00AA00C00905}\"
""
"gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
)
(startapp "RegSvr32" "C:\\WINDOWS\\system32\\comdlg32.ocx")
)
(progn
(setq wincomdlg (vlax-create-object "mscomdlg.commondialog"))
(vlax-put-property wincomdlg 'CancelError :VLAX-TRUE)
(vlax-put-property wincomdlg 'MAXFILESIZE 32767)
(vlax-put-property
wincomdlg
'FLAGS
(+ 4 512 524288 1048576 1024)
)
(vlax-put-property
wincomdlg
'DIALOGTITLE
"请选择要修改的DWG文件"
)
(vlax-put-property wincomdlg 'filter "*.dwg|*.dwg")
(vlax-put-property wincomdlg 'initdir initdir)
(vlax-invoke-method wincomdlg 'showopen)
(setq filem (vlax-get wincomdlg 'filename))
(vlax-release-object wincomdlg)
(mapcar '(lambda (x) (vl-string-left-trim "\" x))
(fstr->lst filem)
)
)
)
)
(defun c:DwgDate (/ fls vers date dbx
dwgprefix cname1 cname2 pname hname
olderr myerr *acadapp* chgatt _dwgdate_id
vers attlst notopen
)
(defun myerr (msg)
(if (/= msg "CANCEL")
(princ msg)
)
(vlax-release-object dbx)
(setq *error* olderr)
(princ)
)
(defun chgatt (tf name val)
(vlax-for obj (if tf
(vlax-get-property dbx 'modelspace)
(vlax-get-property dbx 'paperspace)
)
(if
(and
(wcmatch (vlax-get-property obj 'objectname)
"*BlockRef*"
)
(wcmatch (vlax-get-property obj 'name) "[tT][kK]*")
(= (vlax-get-property obj 'hasattributes)
:vlax-true
)
)
(progn
(mapcar
'(lambda (att)
(if (= (vlax-get-property att 'tagstring)
name
)
(vlax-put-property
att
'textstring
val
)
)
)
(vlax-invoke obj 'getattributes)
)
)
)
)
)
(setq *acadapp* (vlax-get-acad-object))
(setq dbx (vlax-invoke-method
*acadapp*
'GetInterfaceObject
(strcat "ObjectDBX.AxDbDocument."
(substr (getvar "acadver") 1 2)
)
)
)
(setq olderr *error*
*error* myerr
)
(if (and dbx
(setq fls (xdl-getfiles))
)
(progn
(if (not _dwgdate_id)
(setq _dwgdate_id (load_dialog "dwgdate.dcl"))
)
(if (not (new_dialog "dwgdate" _dwgdate_id))
(exit)
)
(action_tile "accept" "(done_dialog 0)")
(action_tile "date" "(setq date $value)")
(action_tile "vers" "(setq vers $value)") ;_可以增加属性
(start_dialog)
(unload_dialog _dwgdate_id)
(setq attlst (list (list "日期" date) (list "版次" vers))) ;_标签名和修改值
(setq dwgprefix (strcat (car fls) "\")
fls (mapcar '(lambda (x)
(strcat dwgprefix x)
)
(cdr fls)
)
)
(mapcar
'(lambda (x / obj)
(vl-catch-all-apply 'vlax-invoke-method (list dbx 'open x :vlax-false))
(if (/= (vlax-get-property dbx 'name) "")
(progn
(mapcar '(lambda (x)
(if (and (/= (cadr x) nil)
(/= (cadr x) "")
)
(progn
(chgatt nil (car x) (cadr x))
(chgatt t (car x) (cadr x))
)
)
)
attlst
)
(vlax-invoke-method dbx 'saveas x)
(princ (strcat "\n" x " Changed Ok!"))
)
(setq notopen (cons x notopen))
)
)
fls
)
(vlax-release-object dbx)
(princ "\nChanged Ok!")
)
)
(if notopen
(progn
(textscr)
(princ "\n==================================================")
(princ "\n以下为未修改文件，可能文件已打开或者为高版本图形!")
(princ "\n==================================================")
(mapcar '(lambda (x) (princ (strcat "\n" x " Not Changed!")))
notopen
)
)
)
(princ)
)

(vl-load-com) 
;; for Windows XP / winnt2k 
;; (xdl-getfiles) 选取多个文件，返回目录文件列表 
(defun xdl-getfiles (/ initdir maxfs flags diatl filter        wincomdlg filem 
                     fstr->lst) 
  (defun fstr->lst (fm / n ff) 
    (setq ff nil) 
    (if        (vl-string-position (ascii "\000") fm) 
      (progn 
        (while (vl-string-position (ascii "\000") fm) 
          (setq n (vl-string-position (ascii "\000") fm)) 
          (setq ff (append ff (list (substr fm 1 n)))) 
          (setq fm (substr fm (+ n 2) (- (strlen fm) n 1))) 
        ) 
        (setq ff (append ff (list fm))) 
      ) 
      (progn 
        (setq ff (vl-filename-directory fm)) 
        (setq ff (list ff (vl-string-subst "" ff fm))) 
      ) 
    ) 
  ) 
  (setq initdir (getvar "dwgprefix")) 
  (if 
    (not 
      (vl-registry-read 
        "HKEY_CLASSES_ROOT\\CLSID\\{7629CFA2-3FE5-101B-A3C9-08002B2F49FB}\\InprocServer32" 
      ) 
    ) 
     (progn 
       (princ 
         "\n第一次运行需要注册控件,程序自动注册,请重新启动系统" 
       ) 
       (VL-REGISTRY-WRITE 
         "HKEY_CLASSES_ROOT\\Licenses\\{4D553650-6ABE-11CF-8ADB-00AA00C00905}\" 
         "" 
         "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj" 
       ) 
 
       (startapp "RegSvr32" "C:\\WINDOWS\\system32\\comdlg32.ocx") 
     ) 
     (progn 
       (setq wincomdlg (vlax-create-object "mscomdlg.commondialog")) 
       (vlax-put-property wincomdlg 'CancelError :VLAX-TRUE) 
       (vlax-put-property wincomdlg 'MAXFILESIZE 32767) 
       (vlax-put-property 
         wincomdlg 
         'FLAGS 
         (+ 4 512 524288 1048576 1024) 
       ) 
       (vlax-put-property 
         wincomdlg 
         'DIALOGTITLE 
         "请选择要修改的DWG文件" 
       ) 
       (vlax-put-property wincomdlg 'filter "*.dwg|*.dwg") 
       (vlax-put-property wincomdlg 'initdir initdir) 
       (vlax-invoke-method wincomdlg 'showopen) 
       (setq filem (vlax-get wincomdlg 'filename)) 
       (vlax-release-object wincomdlg) 
       (mapcar '(lambda (x) (vl-string-left-trim "\" x)) 
               (fstr->lst filem) 
       ) 
     ) 
  ) 
) 
(defun c:DwgDate (/            fls              vers        date          dbx 
                  dwgprefix cname1    cname2        pname          hname 
                  olderr    myerr     *acadapp*        chgatt          _dwgdate_id 
                  vers            attlst notopen 
                 ) 
  (defun myerr (msg) 
    (if        (/= msg "CANCEL") 
      (princ msg) 
    ) 
    (vlax-release-object dbx) 
    (setq *error* olderr) 
    (princ) 
  ) 
  (defun chgatt        (tf name val) 
    (vlax-for obj (if tf 
                    (vlax-get-property dbx 'modelspace) 
                    (vlax-get-property dbx 'paperspace) 
                  ) 
      (if 
        (and 
          (wcmatch (vlax-get-property obj 'objectname) 
                   "*BlockRef*" 
          ) 
          (wcmatch (vlax-get-property obj 'name) "[tT][kK]*") 
          (= (vlax-get-property obj 'hasattributes) 
             :vlax-true 
          ) 
        ) 
         (progn 
           (mapcar 
             '(lambda (att) 
                (if (= (vlax-get-property att 'tagstring) 
                       name 
                    ) 
                  (vlax-put-property 
                    att 
                    'textstring 
                    val 
                  ) 
                ) 
              ) 
             (vlax-invoke obj 'getattributes) 
           ) 
         ) 
      ) 
    ) 
  ) 
  (setq *acadapp* (vlax-get-acad-object)) 
  (setq        dbx (vlax-invoke-method 
              *acadapp* 
              'GetInterfaceObject 
              (strcat "ObjectDBX.AxDbDocument." 
                      (substr (getvar "acadver") 1 2) 
              ) 
            ) 
  ) 
  (setq        olderr        *error* 
        *error*        myerr 
  ) 
  (if (and dbx 
           (setq fls (xdl-getfiles)) 
      ) 
    (progn 
      (if (not _dwgdate_id) 
        (setq _dwgdate_id (load_dialog "dwgdate.dcl")) 
      ) 
      (if (not (new_dialog "dwgdate" _dwgdate_id)) 
        (exit) 
      ) 
      (action_tile "accept" "(done_dialog 0)") 
      (action_tile "date" "(setq date $value)") 
      (action_tile "vers" "(setq vers $value)") ;_可以增加属性 
      (start_dialog) 
      (unload_dialog _dwgdate_id) 
      (setq attlst (list (list "日期" date) (list "版次" vers))) ;_标签名和修改值 
      (setq dwgprefix (strcat (car fls) "\") 
            fls              (mapcar '(lambda (x) 
                                 (strcat dwgprefix x) 
                               ) 
                              (cdr fls) 
                      ) 
      ) 
      (mapcar 
        '(lambda (x / obj) 
           (vl-catch-all-apply 'vlax-invoke-method (list dbx 'open x :vlax-false)) 
           (if (/= (vlax-get-property dbx 'name) "") 
             (progn 
               (mapcar '(lambda        (x) 
                          (if (and (/= (cadr x) nil) 
                                   (/= (cadr x) "") 
                              ) 
                            (progn 
                              (chgatt nil (car x) (cadr x)) 
                              (chgatt t (car x) (cadr x)) 
                            ) 
                          ) 
                        ) 
                       attlst 
               ) 
               (vlax-invoke-method dbx 'saveas x) 
               (princ (strcat "\n" x " Changed Ok!")) 
             ) 
             (setq notopen (cons x notopen)) 
           ) 
         ) 
        fls 
      ) 
      (vlax-release-object dbx) 
      (princ "\nChanged Ok!") 
    ) 
  ) 
  (if notopen 
    (progn 
      (textscr) 
      (princ "\n==================================================") 
      (princ "\n以下为未修改文件，可能文件已打开或者为高版本图形!") 
      (princ "\n==================================================") 
      (mapcar '(lambda (x) (princ (strcat "\n" x " Not Changed!"))) 
              notopen 
      )       
    ) 
  ) 
  (princ) 
)

Dcl

dwgdate : dialog {
label = "属性修改";
: row {
: column {
: edit_box {
label = "日期";
key = "date";
width = 10;
}
: edit_box {
label = "版次";
key = "vers";
width = 10;
}
}
: column {
: edit_box {
label = "设计";
key = "dn";
width = 10;
}
}
}
ok_cancel;
}

lidejun_55 · 发表于 2006-4-9 17:40:59

谢谢，有空好好学习一下！

LUCAS · 发表于 2006-4-11 16:37:37

使用Objectdbx保留預覽圖的arx

http://www.mjtd.com/bbs/dispbbs. ... ID=43293&page=2

dhxf · 发表于 2006-6-6 20:26:53

参数类型错误: VLA-OBJECT nil
?
XP+CAD05

bjzjt · 发表于 2006-6-7 10:51:35

下面代码中:
(vlax-invoke-method
      *acadapp*
      'GetInterfaceObject
      (strcat "ObjectDBX.AxDbDocument."
      (substr (getvar "acadver") 1 2)
      )
      )
ObjectDBX.AxDbDocument 是哪里来的?能指点一下相关的学习资料吗?

aeo · 发表于 2007-1-10 22:48:32

http://discussion.autodesk.com/thread.jspa?threadID=480271

r15 的cad安装版本的axdb15.dll是不可以独立的
可以在3dmax里面找到这个文件,copy过来,
保证有这个文件,再regsvr32.exe它

账号		自动登录	找回密码
密码			立即注册

[教学]：一个用 ObjectDBX 批量修改图形特定内容的程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子