再发一遍图库代码(源码)
本帖最后由 尘缘一生 于 2022-12-14 18:05 编辑图库管理，这个功能是很有用的，目前，基本成熟起来了，源码记住是 《信》的，不是我原创
所以，我不能发布全面出来，再者，也提不出各种嵌套，
代码最大的价值，我一直认为，是一种思路，概念，具体代码，就去写就是了，
鉴于从前发的，BUG不少，所以，还是发下最新修改的这一版。
本次代码，是支持三种版本，简体，繁体，英文
一套代码，支持三种版本，也是我这几天着重的一种探索，并不想写三套代码出来，
因为，实在是没有功夫去维护去，我想这也是大家都希望的一种方式。
对重要的函数，发一下
[*];;语言版本:获得 $Lgver全局变量--(一级)-----
[*](defun sllanguage (/ str)
[*](setq str (getvar "syscodepage")) ;显示所在地区的代码
[*](cond
[*] ((= str (strcase "ansi_936"));;CAD是简体版)
[*] (setq $Lgver 1 $hz "hz" $xz "xz")
[*] )
[*] ((= str (strcase "ansi_950")) ;繁体版
[*] (setq $Lgver 2 $hz "fan" $xz "fank")
[*] )
[*] ((and (/= str (strcase "ansi_936")) (/= str (strcase "ansi_950")));;英文或其他版
[*] (setq $Lgver 3 $hz "hz" $xz "xz")
[*] )
[*])
[*])
[*];;简体、繁体、英文提示---(一级)-----
[*];;msg1 简体字 nilmsg2 繁体字 nil msg3 英文 nil--
[*](defun slmsg (msg1 msg2 msg3 / msg)
[*](cond
[*] ((= $Lgver 1)
[*] (setq msg msg1)
[*] )
[*] ((= $Lgver 2) ;繁体版
[*] (setq msg msg2)
[*] )
[*] ((= $Lgver 3)
[*] (setq msg msg3)
[*] )
[*])
[*]msg ;;输出信息
[*])
对不起各位，必须收一币，如果你觉得源码都不是我提供，不值，请你不要下载！!
三领设计V3.O 永久更新地址
链接：https://pan.baidu.com/s/1BZHwWKiJdDK6NulZZV87Xw
提取码：uan9
timmy521 发表于 2022-12-22 17:42
少一个函数 DCL2LISP
[*];; DCL写进LISP函数------(一级)----------
[*](defun dcl2lisp (lst_str / str f)
[*](setq &file (getfilen ".dcl") f (open &file "w"))
[*](foreach str lst_str
[*] (princ "\n" f)
[*] (princ str f)
[*])
[*](close f)
[*]&file ;;返回
[*])
[*];;卸载DCL，删除临时DCL文件-----(一级)---------
[*](defun slunloaddcl (id /)
[*](unload_dialog id)
[*](sl:del-fil &file)
[*](gc)
[*])
[*];;取得临时文件名-----(一级)----------
[*];;exn 扩展名 ".dcl" ".dwg" nil 返回不带扩展名 路径 "D:\\temp\123"
[*];;用法 (getfilen ".dcl") (getfilen nil)
[*](defun getfilen (exn)
[*](setq &file (vl-filename-mktemp "" "" exn))
[*]&file
[*])
[*];删除文件--------(一级)------
[*];(sl:del-fil "D:\\简历.docx")
[*](defun sl:del-fil (file / fso oFile att ent ss)
[*](vl-catch-all-apply
[*] (function
[*] (lambda ()
[*] (if (= (vl-file-delete file) nil)
[*] (progn
[*] (setq fso (vlax-create-object "Scripting.FilesystemObject"))
[*] (setq oFile (vlax-invoke fso 'GetFile File));易报错(发生意外),原因尚不清楚
[*] (setq att (logand 1 (vlax-get-property oFile 'Attributes)))
[*] (if (/= att 0) (vlax-put-property oFile 'Attributes 0))
[*] (setq fildir (vl-filename-directory file))
[*] (setq ss (vl-directory-files fildir (strcat (vl-filename-base file) (vl-filename-extension file)) 0))
[*] (foreach ent ss
[*] (vlax-invoke fso "deletefile" (strcat fildir "\\" ent) :vlax-false)
[*] )
[*] (vlax-release-object oFile)
[*] (vlax-release-object fso)
[*] )
[*] )
[*] )
[*] )
[*])
[*])
所以你自己都觉得你提供是不是源码，你提供的是思路，概念。 为什么下载不了。。:'( 权限太高 看不了谢谢 权限设置太高 设置东西了，不想给别人下载 444444444444 感谢大佬分享~ 一直觉得兄台的语言是最有魅力的 买了,希望继续更新,尤其对新版本cad支持哈.