;;;借花献佛,用我的改了一个,希望是你要的
(Defun SaveCommand (bak b)
(if
备份的同时删除上一个备份的就好了，不然太占空间！ tranney 发表于 2014-7-26 12:14 static/image/common/back.gif
请问楼上可是它山之石 另存的源码么？
不是他的哦 顶一下 参考参考。谢谢分享
初始化及反应器相关代码如下：
EF_Cloud_Initial.lsp
序号代码
001.
002.
003.
004.
005.
006.
007.
008.
009.
010.
011.
012.
013.
014.
015.
016.
017.
018.
019.
020.
021.
022.
023.
024.
025.
026.
027.
028.
029.
030.
031.
032.
033.
034.
035.
036.
037.
038.
039.
040.
041.
042.
043.
044.
045.
046.
047.
048.
049.
050.
051.
052.
053.
054.
055.
056.
057.
058.
059.
060.
061.
062.
063.
064.
065.
066.
067.
068.
069.
070.
071.
072.
073.
074.
075.
076.
077.
078.
079.
080.
081.
082.
083.
084.
085.
086.
087.
088.
089.
090.
091.
092.
093.
094.
095.
096.
097.
098.
099.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
;EF_Cloud::Config 系统配置(全局)
;EF_Cloud::Mac 本机MAC
;EF_Cloud::Name 云图名称
;EF_Cloud::CloudPath 本机云同步目录
;EF_Cloud::Path 云图同步位置
;EF_Cloud::Enable 是否开启新图
;EF_Cloud::AutoClose 自动关闭旧图
;EF_Cloud::Type 同步类型
;EF_Cloud::Save 手工存储
;EF_Cloud::BackupNum备份数量
;启动设置
(defun EF_Cloud:Initial ( / lstMac lstConfig Mac e)
(setq EF_Cloud::PCName (EF_Cloud:PCName)) ;本机名称
;(setq EF_Cloud::Mac (car (EF_Cloud:MacAddr))) ;本机MAC
(setq EF_Cloud::Mac (EF_Cloud:MacAddr))
;(if (not (listp Mac)) (setq Mac (list Mac)))
(if (not (setq EF_Cloud::Name (EF:getVar "EF_Cloud::Name")))
(setq EF_Cloud::Name "")
)
;(setq EF_Cloud::DWGConfig (EF:getVar "EF_Cloud")) 图纸配置
(cond ((setq EF_Cloud::ConfigFile (findfile "EF_Cloud.cfg")) ;系统配置文件
(setq EF_Cloud::Config (EF_Cloud:File->List EF_Cloud::ConfigFile)) ;系统配置
)
((setq EF_Cloud::ConfigFile (findfile "EF_Cloud.Vlx"))
(setq EF_Cloud::ConfigFile (strcat (vl-filename-directory EF_Cloud::ConfigFile) "\\EF_Cloud.cfg"))
(setq EF_Cloud::Config (EF_Cloud:File->List EF_Cloud::ConfigFile))
)
(T
(alert "找不到EF_Cloud.vlx及EF_Cloud.cfg文件，请将其放入CAD搜索路径中")
)
)
(setq EF_Cloud::SYSConfig (cadr (assoc "云同步" EF_Cloud::Config)))
(foreach e (reverse EF_Cloud::SYSConfig)
(if (EF_Cloud:CheckMac EF_Cloud::Mac (car e))
(progn
(setq EF_Cloud::CloudPath (caddr e))
)
)
)
;|本机云同步目录
(while (or (not EF_Cloud::CloudPath)
(not (vl-file-directory-p EF_Cloud::CloudPath))
)
(progn
(alert "本机尚未设置同步目录或同步目录无效，按<确定>设置同步目录")
(EF_Cloud:Sys-Set)
)
)|;
(if (not (setq EF_Cloud::AutoOpen (cadr (assoc "自动打开" EF_Cloud::Config)))) ;提醒设置
(setq EF_Cloud::AutoOpen "1")
)
(if (not (setq EF_Cloud::Type (cdr (assoc "同步类型" EF_Cloud::Config)))) ;同步DWG
(setq EF_Cloud::Type '((".DWG" T)
(".DXF" T)
(".SV$" nil)
)
)
)
(if (not (setq EF_Cloud::BackupNum (cadr (assoc "备份数量" EF_Cloud::Config)))) ;备份数量
(setq EF_Cloud::BackupNum 3)
)
(if (not (setq EF_Cloud::AutoClose (cadr (assoc "自动关闭" EF_Cloud::Config)))) ;提醒设置
(setq EF_Cloud::AutoClose "1")
)
(if (not (setq EF_Cloud::SaveCount (EF:getVar "EF_Cloud::SaveCount")))
(setq EF_Cloud::SaveCount 0)
)
;|
(if (or (not (setq EF_Cloud::Path (EF:getvar "EF_Cloud::Path")))
(= EF_Cloud::Path "")
(not (vl-file-directory-p (EF_Cloud:CloudPath->FullPath EF_Cloud::Path)))
)
(EF:Setvar "EF_Cloud::Path" (setq EF_Cloud::Path ""))
)|;
(if (or (not (setq EF_Cloud::Path (EF:getvar "EF_Cloud::Path")))
(= EF_Cloud::Path "")
(not (vl-file-directory-p (EF_Cloud:CloudPath->FullPath EF_Cloud::Path)))
)
(setq EF_Cloud::Path "<CLOUD>")
)
(setq EF_Cloud::Path (EF_Cloud:CloudPath->FullPath EF_Cloud::Path))
(if (and (setq EF_Cloud::Enable (EF:getvar "EF_Cloud::Enable"))
(/= EF_Cloud::Path "")
(/= EF_Cloud::Name "")
(and EF_Cloud::CloudPath
(vl-file-directory-p EF_Cloud::CloudPath)
)
)
(progn
(princ "\n[信·云同步] 云同步开启 <EF_Cloud_Config> 配置")
(EF_Cloud:Start)
)
(progn
(princ "\n[信·云同步] :云同步暂停 <EF_Cloud_Config> 配置")
(EF_Cloud:Stop)
)
)
(if (= EF_Cloud::AutoOpen "1") (EF_Cloud:DWG-AutoOpen) (EF_Cloud:DWG-Check))
)
(defun EF_Cloud:BeginSave (rec lst)
(if (or EF_Cloud::Save
(and EF_Cloud::Enable
(cadr (assoc (strcase (vl-filename-extension (cadr lst))) EF_Cloud::Type))
)
)
(EF:Setvar "EF_Cloud::SaveCount" (setq EF_Cloud::SaveCount (1+ EF_Cloud::SaveCount)))
)
)
(defun EF_Cloud:CloudSave (rec lst / sFile sFileName path lstBackup)
(if (and EF_Cloud::CloudPath
(vl-file-directory-p EF_Cloud::CloudPath)
)
(progn
(setq path (EF_Cloud:CloudPath->FullPath EF_Cloud::Path))
(if (= ".SV$" (strcase (vl-filename-extension (cadr lst))))
(setq sFile (strcat EF_Cloud::Name "[" (EF_Cloud:getTime) " №" (rtos EF_Cloud::SaveCount 2 0) "].DWG"))
(setq sFile (strcat EF_Cloud::Name "[" (EF_Cloud:getTime) " №" (rtos EF_Cloud::SaveCount 2 0) "]" (vl-filename-extension (cadr lst))))
)
(cond ((and (not EF_Cloud::Save) (not EF_Cloud::Enable)))
((= EF_Cloud::Name "") (princ "\n[信·云同步] :当前图纸未命名 <EF_Cloud_Config> 配置"))
((and EF_Cloud::Path
(or EF_Cloud::Save (cadr (assoc (strcase (vl-filename-extension (cadr lst))) EF_Cloud::Type)))
(vl-file-copy(cadr lst)(strcat path "\\" sFile))
)
(princ (strcat "\n[信·云同步] 成功保存为:" path "\\" sFile))
(setq lstBackup (EF_Cloud:SearchCloud))
(repeat EF_Cloud::BackupNum (setq lstBackup (cdr lstBackup)))
(mapcar '(lambda (e)
(setq e (car e))
(if (vl-file-delete (strcat path "\\" e))
(princ (strcat "\n[信·云同步] 成功删除过期文件:" path "\\" e))
)
)
lstBackup
)
)
(T
(princ "\n[信·云同步] :无法复制文件,可能云目录不存在")
)
)
(if EF_Cloud::Save (setq EF_Cloud::Save nil))
)
(princ "本机未设置云目录，使用EF_Cloud_Config命令设置")
)
)
(defun EF_Cloud:Start ()
(if EF_Cloud::Rec
(vlr-add EF_Cloud::Rec)
(setq EF_Cloud::Rec (vlr-dwg-reactor nil '((:vlr-beginSave . EF_Cloud:BeginSave) (:vlr-saveComplete . EF_Cloud:CloudSave))))
)
)
(defun EF_Cloud:Stop ()
(if EF_Cloud::Rec (vlr-remove EF_Cloud::Rec))
)
(EF_Cloud:Initial)
页:
1
[2]