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

iceberg2509

多年以前注册明经，一直潜水多，冒泡少。
今天无聊，发布两个源代码程序，里面用到了objectdbx、MSComDlg.CommonDialog、shell、递归等。里面很多函数来自于明经。
声明一下，我不是编程专家，程序里肯定还有些bug，告诉我bug的人我要感谢你，要拍砖的人请绕道。
如果觉得好用，不妨给俺加点分



经检查，上述lsp文件中还缺如下几个函数，请自行将如下代码复制到dwgconverter.lsp文件末尾，再加载。
;;=========获取ObjectDBX版本字符串============
(defun GetObjectDBXVer (/ VERSION)
  (if (>= (setq VERSION (atoi (getvar "acadver"))) 16)
    (strcat "ObjectDBX.AxDbDocument." (itoa VERSION))
    nil
  )     ;end if
)     ;end defun

;;;===========从图元表中提取dxf组码值函数组码值函数
(defun dxf (Item dxfList /) (cdr (assoc Item dxfList))) ;defun

;;=================删除文件函数===================
;; 能删除所有文件，不管只读、隐藏与否，都能删除
;; vl-file-delete不能删除只读文件
;;Scripting.FileSystemObject格式
;;fso.DeleteFile ( filespec[, force] )
;;参数
;; fso  必选项, 应为 FileSystemObject 的名称。
;; filespec 必选项, 要删除的文件的名称,filespec 可以在最后的路径成分中包含通配字符。
;; force   可选项, Boolean 值，如果要删除设置了只读属性的文件，则为 true ；如果不删除则为 false （默认）。
;; Arguments [Typ]:
;;   Fil = FileName, "C:\\test\\Autoexec.bat" [STR]
;; Notes:
;;   - Requires ScrRun.dll.
;; USAGE: (DelFile "C:\\test\\*.*")
;; USAGE: (DelFile "C:\\test\\Autoexec.bat")
(defun DeleteFile (FIL / FILSYS FILDIR SS ENT)
  (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))
  (setq FILDIR (vl-filename-directory FIL))
  (setq
    SS (vl-directory-files
  FILDIR
  (strcat (vl-filename-base FIL) (vl-filename-extension FIL))
  1
       )
  )
  (foreach ENT SS
    (vlax-invoke
      FILSYS
      "deletefile"
      (strcat FILDIR "\\" ENT)
      :vlax-false
    )
  )
  (vlax-release-object FILSYS)
  (princ)
)     ;end defun


(defun AddSeprate (DataList delimiter / i len dealdata TempData)
;;添加分隔符函数
  (setq i   1
len (length DataList)
  )
  (if len
    (progn
      (setq dealdata (nth 0 DataList))
      (if (numberp dealdata)
(setq dealdata (rtos dealdata 2))
      )
      (repeat (1- len)
(setq TempData (nth i DataList))
(if (numberp TempData)
   (setq TempData (rtos TempData 2))
)
(setq dealdata (strcat dealdata delimiter TempData))
(setq i (1+ i))
      )
    )
  )
  (setq DataList dealdata)
)
(defun makelist        (str pat / i j n lst)
;;生成表记录函数：把字符串变为表
  (cond
    ((/= (type str) (type pat) 'STR))
    ((= str pat) '(""))
    (T
     (setq i 0
           n (strlen pat)
     )
     (while (setq j (vl-string-search pat str i))
       (setq lst (cons (substr str (1+ i) (- j i)) lst)
             i         (+ j n)
       )
     )
     (reverse (cons (substr str (1+ i)) lst))
    )
  )
)

无尽的手残

命令: DWGCONVERTER
错误:Automation 错误。 加载 VBA 时出现问题
AutoCAD 变量设置被拒绝: "acadlspasdoc" nil
这个怎么解决。。。。。。。。看了评论也没解

qwerasdf123456

顶22222222222222222222222222222

尒樣僮

好长的代码 眼晕 先下载慢慢研究

革天明

谢谢楼主，分享这么好的代码

lrd1861

支持一下辛苦了

hnfsf

多谢版主！好用，谢谢了！！

crtrccrt

辛苦了
辛苦了

xyz2009xyz

函数里面好像有多余括号，适用版本提示2010及以上

iceberg2509

xyz2009xyz 发表于 2011-10-16 10:19
函数里面好像有多余括号，适用版本提示2010及以上

因为这个函数是从我的函数库里挑出来的，因此出现了多余括号，我已经修改完毕。
至于只能用于2010版本以上，那是程序中的限制，既然是源代码，那么自己可以修改，只要支持objectdbx的autocad版本就成。

iceberg2509

里面可能还缺个别引用的函数，我没有仔细查，如果有缺的，请大伙提出来，我一并补上。

xyz2009xyz

iceberg2509 发表于 2011-10-16 12:04
因为这个函数是从我的函数库里挑出来的，因此出现了多余括号，我已经修改完毕。
至于只能用于2010版本以 ...

可惜啊，我不会改哦，不知道有没人改下呢，
cad2004

yshf

不错不错，