[求助]秋枫大侠再帮忙看看好吗？如果是COPY PAT的话又不行呢？

userzhl · 发表于 2006-4-4 22:36:00

本帖最后由作者于 2006-4-11 22:50:37 编辑

(defun currTemplateDwgPath ()
;;;这个范例返回
;;;TemplateDWGPath的当前的设定值，接着改变它的值
;;;最后重设为原来的值
(VL-LOAD-COM)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument AcadObject)
mSpace (vla-get-ModelSpace AcadDocument)
)
(setq preferenceSel (vla-get-Preferences AcadObject))
;;;取出当前的 TemplateDWGPath值
(setq fileSel (vla-get-Files preferenceSel))
(setq currTemplateDwgPath (vla-get-TemplateDwgPath fileSel))
)
(defun qf_FSO_CopyFile (src dest / fso catchit)
......

;; 正式安装dwt
(mapcar ' installdwt
'("acad.dwt"
)
)
为何会出错的？
Error: 参数类型错误: stringp nil

秋枫 · 发表于 2006-4-6 20:20:00

(defun installdwt (src / acadver dest)
(setq acadver (atof (getvar "acadver")))
(if (and (>= acadver 15.0) (< acadver 16.0))
; AutoCAD 2000/2000i/2002
(setq dest (strcat (vl-filename-directory (findfile "acad.exe"))
src
)
)
; else AutoCAD 2004+
(setq dest (strcat (getvar "currTemplateDwgPath")
src
)
)
)
(copyfile src dest)
)

红色部分返回nil
改成

(defun installdwt (src / acadver dest)
(setq acadver (atof (getvar "acadver")))
(if (and (>= acadver 15.0) (< acadver 16.0))
; AutoCAD 2000/2000i/2002
(setq dest (strcat (vl-filename-directory (findfile "acad.exe"))
src
)
)
; else AutoCAD 2004+
(setq dest (strcat (currTemplateDwgPath)
src
)
)
)
(copyfile src dest)
)

秋枫 · 发表于 2006-4-6 20:37:00

另外，因为2002与2004以上版本区别对待。
2004以上版本中你那个样板文件路径是可以通过系统变量访问的
LOCALROOTPREFIX
所以你那个函数currTemplateDwgPath是不必要的。

; else AutoCAD 2004+
(setq dest (strcat (getvar "LOCALROOTPREFIX") "Template\"
src
)
)

userzhl · 发表于 2006-4-7 00:27:00

本帖最后由作者于 2006-4-11 22:51:25 编辑

非常的感谢秋枫大侠，我试了后可以了，解决了我很久的困扰，非常感谢！

但我如果是COPY“acadiso.pat”覆盖原来的文件却不行，不知为何？

(vl-load-com)
(defun qf_FSO_CopyFile (src dest / fso catchit)
(setq    catchit
     (vl-catch-all-apply
       (function
         (lambda ()
           (setq fso
              (vlax-create-object "Scripting.FileSystemObject")
           )
......

               "\\Support\\"
               src
           )
    )
                        ; else AutoCAD 2004+
    (setq dest (strcat (getvar "ROAMABLEROOTPREFIX")
               "Support\\"
               src
           )
    )
)
( copyfile src dest)
)
(mapcar    ' installSupport
    '("acadiso.pat"
     )
)

无痕 · 发表于 2006-4-7 04:18:00

秋枫发表于2006-4-6 20:37:00 另外，因为2002与2004以上版本区别对待。 2004以上版本中你那个样板文件路径是可以通过系统变量访问的 LOCALROOTPREFIX...

函数currTemplateDwgPath 还是是必要的

样板文件路径的设定可以更改；改了以后就不是 LOCALROOTPREFIX 所指的位置了

userzhl · 发表于 2006-4-11 22:49:00

非常的感谢秋枫大侠，我试了后可以了，解决了我很久的困扰，非常感谢！

但我如果是COPY“acadiso.pat”覆盖原来的文件却不行，不知为何？

(vl-load-com)
(defun qf_FSO_CopyFile (src dest / fso catchit)
(setq    catchit
     (vl-catch-all-apply
       (function
         (lambda ()
           (setq fso
              (vlax-create-object "Scripting.FileSystemObject")
           )
           (if (or (not (findfile dest)) ; 目标不存在
               (and
             (findfile dest) ; 目标文存在但比较旧
             (> (vlax-get-property
                  (vlax-invoke-method
                fso
                'getfile
                (findfile src)
                  )
                  'datelastmodified
                )
                (vlax-get-property
                  (vlax-invoke-method
                fso
                'getfile
                (findfile dest)
                  )
                  'datelastmodified
                )
             )
               )
           )
         (progn
           (if (findfile dest)
             (vl-file-delete dest)
           )
           (vlax-invoke-method fso 'copyfile (findfile src) dest -1)
           (princ "\n")
           (princ (findfile dest))
           (princ "已更新.")
         )
           )
           (vlax-release-object fso)
         )                ;end of lambda
       )                ;end of Function
       nil
     )
)
(if (vl-catch-all-error-p catchit)
    nil
    'T
)
)
(defun copyfile (src dest)
(if (null ( qf_FSO_CopyFile src dest))
    ;; 如果采用FSO复制文件失败的话可以在这里定义其它复制方式
    ;; (vl_copyfile src dest)
    nil
)
)
(defun installSupport (src / acadver dest)
(setq acadver (atof (getvar "acadver")))
(if (and (>= acadver 15.0) (< acadver 16.0))
                    ; AutoCAD 2000/2000i/2002
    (setq dest (strcat (vl-filename-directory (findfile "acad.exe"))
               "\\Support\\"
               src
           )
    )
                        ; else AutoCAD 2004+
    (setq dest (strcat (getvar "ROAMABLEROOTPREFIX")
               "Support\\"
               src
           )
    )
)
( copyfile src dest)
)
(mapcar    ' installSupport
    '("acadiso.pat"
     )
)

userzhl · 发表于 2006-4-12 15:03:00

是不是要把acadiso.pat先改名，然后再复制？

秋枫 · 发表于 2006-4-15 08:58:00

to楼上：你的Src没有找到吧。自己一句一句调试很容易发现问题的。用vl的跟踪一下就可以了。

to无痕：同意，你是对的。那个函数还是必要的。

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