无聊发布CAD版本转换以及去除教育版戳记程序源代码

辉/:) · 发表于 2012-7-28 20:57:10

给力的就U要顶下楼主

自贡黄明儒 · 发表于 2012-7-30 12:21:50

楼主用了什么函数，为什么不支持04版呢？如果能支持04版就太好了。

happytalk · 发表于 2012-8-6 16:34:56

elitefish的微博

chenlight · 发表于 2012-8-13 22:26:52

不错，对版本转换有兴趣

chlh_jd · 发表于 2012-8-15 00:54:30

本帖最后由 chlh_jd 于 2012-8-15 01:01 编辑

这个还是比较给力的！
缺少AddSeprate函数，getmutifiles不支持64位系统的，可以用下面这个

(setq *Is64Bit* (wcmatch (getvar "platform") "*64*"));;; 修改依据: xiaomu 2005-10-12
;;;****************************************************************************
;;; No.5-3 Windows多文件选择(适用于CADR15以上) 函数
;;; 说明: 本函数使用MsComDlg.Commondialog对象(Comdlg.OCX)
;;; 调用: (ayGetMultFiles "多选文件" "图形文件(*.dwg)|*.dwg|所有(*.*)|*.*" "")
;;; (ayGetMultFiles "" "" "E:\\厦门维高\\办公楼\")
;;; 返回: ("C:\\DWG" "7b.dwg" "7c.dwg" "1.Dwg")
;;;****************************************************************************;;; Edited by GSLS(SS) 2012-05-06
(if
(/=
(vl-registry-read
"HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905"
)
"gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
)
(vl-registry-write
"HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905"
""
"gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"
)
)
(defun ayGetMultFiles (strTitle strFilter strInitDir /
Maxfiles Flags WinDlg mFiles
Catchit b
)
(vl-load-com) ;_(setq strTitle "多选文件" strFilter "图形文件(*.dwg)|*.dwg|所有(*.*)|*.*" strInitDir "")
(if *Is64Bit*
;_Edited By GSLS(SS) 2012.12.04 , refer http://www.theswamp.org/index.php?topic=17672.0
(progn
(setq
Catchit (vl-catch-all-apply
(function dcl_MultiFileDialog)
(list
(list strfilter)
strTitle
strInitDir
)
)
)
(if (not (vl-catch-all-error-p Catchit)) ;处理"取消"错误.
(progn
(setq strInitDir (vl-string-right-trim (last (string->strlst (car Catchit) "\")) (car Catchit)))
(foreach a Catchit
(setq b (vl-string-subst "" strInitDir a))
(setq mFiles (cons b mFiles))
)
(cons (vl-string-right-trim "\" strinitdir) (reverse mfiles))
)
nil ;else
)
)
(progn
(setq WinDlg (vlax-create-object "MSComDlg.CommonDialog"))
(if (not WinDlg)
(progn ;then
(princ
"\n【错误】系统中未安装通用控件Comdlg.OCX, 请安装后再运行!"
)
(setq mFiles nil)
) ;end_progn then
(progn ;else
(setq Maxfiles 32767)
(setq Flags (+ 4 512 524288 1048576 1024))
(vlax-put-property WinDlg (quote CancelError) :vlax-true)
(vlax-put-property WinDlg (quote MaxFileSize) Maxfiles)
(vlax-put-property WinDlg (quote Flags) Flags)
(vlax-put-property WinDlg (quote DialogTitle) strTitle)
(vlax-put-property WinDlg (quote Filter) strFilter)
(vlax-put-property WinDlg (quote InitDir) strInitDir)
(setq Catchit nil)
(setq
Catchit (vl-catch-all-apply
(function
(lambda ()
(vlax-invoke-method WinDlg 'ShowOpen)
(setq mFiles (vlax-get WinDlg 'Filename))
)
)
)
)
(vlax-release-object WinDlg)
(if (not (vl-catch-all-error-p Catchit)) ;处理"取消"错误.
(ayFSTR->LST mFiles)
nil ;else
) ;end_if
) ;end_progn
) ;end_if
)
);end_if
);end_defun
;;;************************************************
;;; No.5-3-1 处理Windows多文件选择返回值函数
;;; 说明: 将"C:\\DWG1\0001.dwg\0002.dwg" 处理成:
;;; ("C:\\DWG1" "1.dwg" "2.dwg") 表形式.
;;;************************************************
(Defun ayFSTR->LST (xMFileStr / mFileList k)
(if (= xMFileStr "")
(setq mFileList nil) ;then
(progn
(if (vl-string-position (ascii "\000") xMFileStr)
(progn
(while (vl-string-position (ascii "\000") xMFileStr)
(setq k (vl-string-position (ascii "\000") xMFileStr))
(setq mFileList
(append mFileList (list (substr xMFileStr 1 k)))
)
(setq xMFileStr (substr xMFileStr
(+ k 2)
(- (strlen xMFileStr) k 1)
)
)
) ;end_while
(setq mFileList
(append mFileList
(list (vl-string-left-trim "\" xMFileStr))
)
)
) ;end_progn then
(progn
(setq mFileList (vl-filename-directory xMFileStr))
(setq
mFileList (list mFileList
(vl-string-left-trim
"\"
(vl-string-subst "" mFileList xMFileStr)
)
)
)
) ;end_progn else
) ;end_if
mFileList
) ;end_progn
) ;end_if
) ;end_defun

(setq *Is64Bit* (wcmatch (getvar "platform") "*64*"));;; 修改依据: xiaomu 2005-10-12 
;;;**************************************************************************** 
;;; No.5-3    Windows多文件选择(适用于CADR15以上) 函数                         
;;; 说明: 本函数使用MsComDlg.Commondialog对象(Comdlg.OCX)                      
;;; 调用: (ayGetMultFiles "多选文件" "图形文件(*.dwg)|*.dwg|所有(*.*)|*.*" "") 
;;;       (ayGetMultFiles ""  "" "E:\\厦门维高\\办公楼\") 
;;; 返回: ("C:\\DWG" "7b.dwg" "7c.dwg" "1.Dwg")                                 
;;;****************************************************************************;;; Edited by GSLS(SS) 2012-05-06 
(if 
  (/= 
    (vl-registry-read 
      "HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905" 
    ) 
    "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj" 
  ) 
   (vl-registry-write 
     "HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905" 
     "" 
     "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj" 
   ) 
) 
(defun ayGetMultFiles (strTitle    strFilter  strInitDir  / 
           Maxfiles    Flags       WinDlg  mFiles 
           Catchit b 
          ) 
  (vl-load-com) ;_(setq strTitle "多选文件" strFilter "图形文件(*.dwg)|*.dwg|所有(*.*)|*.*" strInitDir "") 
  (if *Is64Bit* 
    ;_Edited By GSLS(SS) 2012.12.04 , refer http://www.theswamp.org/index.php?topic=17672.0 
    (progn 
      (setq 
  Catchit  (vl-catch-all-apply 
      (function dcl_MultiFileDialog) 
      (list 
        (list strfilter) 
        strTitle 
        strInitDir 
      ) 
    ) 
      ) 
      (if (not (vl-catch-all-error-p Catchit)) ;处理"取消"错误. 
  (progn 
    (setq strInitDir (vl-string-right-trim (last (string->strlst (car Catchit) "\")) (car Catchit))) 
    (foreach a Catchit 
      (setq b (vl-string-subst "" strInitDir a)) 
      (setq mFiles (cons b mFiles)) 
      ) 
    (cons (vl-string-right-trim "\" strinitdir) (reverse mfiles)) 
    ) 
  nil        ;else 
      ) 
    ) 
    (progn 
      (setq WinDlg (vlax-create-object "MSComDlg.CommonDialog")) 
      (if (not WinDlg) 
  (progn        ;then 
    (princ 
      "\n【错误】系统中未安装通用控件Comdlg.OCX, 请安装后再运行!" 
    ) 
    (setq mFiles nil) 
  )        ;end_progn then 
  (progn        ;else 
    (setq Maxfiles 32767) 
    (setq Flags (+ 4 512 524288 1048576 1024)) 
    (vlax-put-property WinDlg (quote CancelError) :vlax-true) 
    (vlax-put-property WinDlg (quote MaxFileSize) Maxfiles) 
    (vlax-put-property WinDlg (quote Flags) Flags) 
    (vlax-put-property WinDlg (quote DialogTitle) strTitle) 
    (vlax-put-property WinDlg (quote Filter) strFilter) 
    (vlax-put-property WinDlg (quote InitDir) strInitDir) 
    (setq Catchit nil) 
    (setq 
      Catchit (vl-catch-all-apply 
          (function 
      (lambda  () 
        (vlax-invoke-method WinDlg 'ShowOpen) 
        (setq mFiles (vlax-get WinDlg 'Filename)) 
      ) 
          ) 
        ) 
    ) 
    (vlax-release-object WinDlg) 
    (if (not (vl-catch-all-error-p Catchit)) ;处理"取消"错误. 
      (ayFSTR->LST mFiles) 
      nil        ;else 
    )        ;end_if 
  )        ;end_progn 
      )          ;end_if 
    ) 
  );end_if 
);end_defun 
;;;************************************************ 
;;; No.5-3-1 处理Windows多文件选择返回值 函数       
;;; 说明: 将"C:\\DWG1\0001.dwg\0002.dwg" 处理成:    
;;;        ("C:\\DWG1" "1.dwg" "2.dwg") 表形式.    
;;;************************************************ 
(Defun ayFSTR->LST (xMFileStr / mFileList k) 
  (if (= xMFileStr "") 
    (setq mFileList nil)    ;then 
    (progn 
      (if (vl-string-position (ascii "\000") xMFileStr) 
  (progn 
    (while (vl-string-position (ascii "\000") xMFileStr) 
      (setq k (vl-string-position (ascii "\000") xMFileStr)) 
      (setq mFileList 
       (append mFileList (list (substr xMFileStr 1 k))) 
      ) 
      (setq xMFileStr (substr xMFileStr 
            (+ k 2) 
            (- (strlen xMFileStr) k 1) 
          ) 
      ) 
    )        ;end_while 
    (setq  mFileList 
     (append mFileList 
       (list (vl-string-left-trim "\" xMFileStr)) 
     ) 
    ) 
  )        ;end_progn then 
  (progn 
    (setq mFileList (vl-filename-directory xMFileStr)) 
    (setq 
      mFileList (list mFileList 
          (vl-string-left-trim 
            "\" 
            (vl-string-subst "" mFileList xMFileStr) 
          ) 
          ) 
    ) 
  )        ;end_progn else 
      )          ;end_if 
      mFileList 
    )          ;end_progn 
  )          ;end_if 
)          ;end_defun

未见AddSeprate 函数,猜想应该是这样的

(defun AddSeprate (lst del)
(apply 'strcat (mapcar (function (lambda (x)(strcat del x)))lst)))

ACAD2011下遇到错误：执行环境无效,

;;错误语句：
(vla-open (vla-get-documents AcadApp) DwgName)

复制代码

lingduwx · 发表于 2012-8-15 12:14:01

顶你了楼主，版本转换对于用低版本CAD软件非常实用，主要是现在的高版本软件使用越来越慢了，
不过请问楼主我的WIN7 32位系统cad 2006中出现两个问题：
1、添加文件夹的时候出现“命令:
DWGCONVERTER

错误:Automation 错误。

命令:
命令: DWGCONVERTER
命令:
命令: 错误:Automation 未知命令“错误:AUTOMATION”。按 F1 查看帮助。”
2、添加文件
直接出现：
当前系统无MSComDlg.CommonDialog对象！

请问楼主这个怎么解决啊
很想要此插件，谢谢

ORCHI · 发表于 2012-9-20 17:36:52

xiaoyingzi 发表于 2011-10-21 09:46
太好了，有源码，希望楼主经常无聊下
修改成支持autocad2004~2010

no function definition: MAKELIST
是不是还缺makelist函数呢

我也是同样的问题，查看了下源代码，似乎还缺少makelist函数。麻烦您能再完善下吗？

simpleye · 发表于 2012-9-22 21:40:53

在CAD2006试了一下，把2004版本转成2010，感觉没变化。

wapor · 发表于 2012-9-24 11:51:14

这个与Eps有什么区别呢！！！

wangph · 发表于 2012-9-24 18:05:16

chlh_jd 发表于 2012-8-15 00:54
这个还是比较给力的！
缺少AddSeprate函数，getmutifiles不支持64位系统的，可以用下面这个

(setq  Catchit  (vl-catch-all-apply
   (function dcl_MultiFileDialog)
   (list  (list strfilter)  strTitle  strInitDir  )
)
请问这句什么意思，是不是缺少dcl_MultiFileDialog函数？

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

[资源] 无聊发布CAD版本转换以及去除教育版戳记程序源代码