[LISP程序]：自编的dwg批量锁定程序

haijiangl · 发表于 2006-8-24 17:52:41

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

锁定核心程序是改编自那个著名的lockup，锁定方式是把所有图元变成一个多重引用的匿名块，无法炸开。

切勿在重要图纸内直接加载lockms.lsp，后果很严重[/COLOR] [/SIZE]

外壳程序是通过使用脚本实现批量锁定的，代码如下：

[FONT=courier new]
;;==============================================================================
;;==============================================================================
(defun c:TW_Batchlock (/ dcl_id pinput poutput filelist
savelist what file2r ow lockm
lockp scrfile scrname scr lockfile
)
(arxload "acetutil.arx" NIL)
(vl-load-com)
(setq dcl_id (load_dialog "TW_BatchLock.dcl"))
(if (not (new_dialog "TW_BatchLock" dcl_id))
(exit)
)
(set_tile "osa" "1")
(set_tile "poutput" "c:\\dwg已加锁")
(setq poutput "c:\\dwg已加锁"
ow 0
lockm 1
lockp 0
)
;定义选择目录程序
(defun getpath (/ res)
(setq res
(strcat
(strcase
(acet-ui-pickdir
"选择一个目录，将添加该目录内所有dwg文件"
(vl-string-right-trim "\" (getvar "dwgprefix"))
"选择目录"
)
)
)
)
)
;定义选择某目录内的所有dwg文件，包含路径前缀
(defun dwginpath (path / dwgfilelist)
(setq dwgfilelist (vl-directory-files path "*.DWG"))
(mapcar '(lambda (x) (strcat path "\" x)) dwgfilelist)
)
;定义将表全新填入对话框中的list_box
(defun push2box (alist boxkey)
(start_list boxkey)
(mapcar 'add_list alist)
(end_list)
)
;定义将字符串附加到对话框中的list_box
(defun add2box (str boxkey)
(start_list boxkey 2)
(add_list str)
(end_list)
)
;定义移除文件列表中被选中的项，并重新填充列表框
(defun getboxsel (boxkey / idlist)
(setq idlist (get_tile boxkey)
idlist (str2list idlist)
idlist (mapcar 'atoi idlist)
)
)
(defun rr (/ idlist file2rl)
(setq idlist (getboxsel "filelist")
file2rl '()
)
(princ (length idlist))
(foreach x idlist
(setq file2rl (cons (nth x filelist) file2rl))
)
(foreach x file2rl
(setq filelist (a_ext_li x filelist))
)
(push2box filelist "filelist")
;(princ id)
)
(action_tile
"pi_b"
"(setq pinput (getpath)) (setq filelist (dwginpath pinput)) (push2box filelist "filelist")"
)
(action_tile
"fi_r"
"(rr)"
)
(action_tile
"poutput"
"(setq poutput $value)"
)
(action_tile
"po_b"
"(setq poutput (getpath)) (set_tile "poutput" poutput)"
)
(action_tile
"oow"
"(alert "加锁后的文件无法恢复，请慎重!!!") (mode_tile "out" 1) (setq ow 1)"
)
(action_tile
"osa"
"(mode_tile "out" 0) (setq ow 0)"
)
(action_tile "lockp" "(setq lockp (atoi $value))")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "lock" "(done_dialog 4)")
(defun beginlock (/ fl1 n app filename ms of om ds cmd)
(if (and filelist (= ow 0))
(progn
(if (not (vl-file-directory-p poutput))
(acet-file-mkdir poutput)
)
(setq fl1 '()
n (strlen pinput)
)
(foreach x filelist
(setq fl1 (cons (strcat poutput (substr x (1+ n))) fl1))
)
(setq savelist (reverse fl1))
(mapcar '(lambda (x y)
(acet-file-copy x y T)
)
filelist
savelist
)
(setq filelist savelist)
(setq scrfile (strcat poutput "\" "TW_batchlock.scr"))
)
(setq scrfile (strcat pinput "\" "TW_batchlock.scr"))
)
(if filelist
(progn
(setq scrname (open scrfile "w"))
(setq lockfile "lockms.lsp")
(foreach x filelist
(setq scr (strcat "open "
x
" "
"(load "
(chr 34)
lockfile
(chr 34)
")"
" qsave close "
)
)
(write-line scr scrname)
)
(close scrname)
(command "script" scrfile)
(princ)
)
)
)
(setq what (start_dialog))
(cond
((= what 4) (beginlock))
((= what 0) (exit))
)
(unload_dialog dcl_id)
)
[/FONT]

[FONT=courier new] 
 
 
;;============================================================================== 
;;============================================================================== 
 
(defun c:TW_Batchlock  (/        dcl_id         pinput           poutput   filelist 
             savelist  what         file2r           ow             lockm 
             lockp     scrfile         scrname   scr             lockfile 
            ) 
 
  (arxload "acetutil.arx" NIL) 
  (vl-load-com) 
 
  (setq dcl_id (load_dialog "TW_BatchLock.dcl")) 
  (if (not (new_dialog "TW_BatchLock" dcl_id)) 
    (exit) 
  ) 
 
  (set_tile "osa" "1") 
  (set_tile "poutput" "c:\\dwg已加锁") 
 
  (setq        poutput        "c:\\dwg已加锁" 
        ow        0 
        lockm        1 
        lockp        0 
  ) 
 
 
                                        ;定义选择目录程序 
  (defun getpath (/ res) 
    (setq res 
           (strcat 
             (strcase 
               (acet-ui-pickdir 
                 "选择一个目录，将添加该目录内所有dwg文件" 
                 (vl-string-right-trim "\" (getvar "dwgprefix")) 
                 "选择目录" 
               ) 
             ) 
           ) 
    ) 
  ) 
 
                                        ;定义选择某目录内的所有dwg文件，包含路径前缀 
  (defun dwginpath (path / dwgfilelist) 
    (setq dwgfilelist (vl-directory-files path "*.DWG")) 
    (mapcar '(lambda (x) (strcat path "\" x)) dwgfilelist) 
  ) 
 
                                        ;定义将表全新填入对话框中的list_box 
  (defun push2box (alist boxkey) 
    (start_list boxkey) 
    (mapcar 'add_list alist) 
    (end_list) 
  ) 
 
                                        ;定义将字符串附加到对话框中的list_box 
  (defun add2box (str boxkey) 
    (start_list boxkey 2) 
    (add_list str) 
    (end_list) 
  ) 
 
                                        ;定义移除文件列表中被选中的项，并重新填充列表框 
  (defun getboxsel (boxkey / idlist) 
    (setq idlist (get_tile boxkey) 
          idlist (str2list idlist) 
          idlist (mapcar 'atoi idlist) 
    ) 
  ) 
 
  (defun rr (/ idlist file2rl) 
    (setq idlist  (getboxsel "filelist") 
          file2rl '() 
    ) 
    (princ (length idlist)) 
 
    (foreach x idlist 
      (setq file2rl (cons (nth x filelist) file2rl)) 
    ) 
 
    (foreach x file2rl 
      (setq filelist (a_ext_li x filelist)) 
    ) 
    (push2box filelist "filelist") 
                                        ;(princ id) 
  ) 
 
 
  (action_tile 
    "pi_b" 
    "(setq pinput (getpath)) (setq filelist (dwginpath pinput)) (push2box filelist "filelist")" 
  ) 
 
  (action_tile 
    "fi_r" 
    "(rr)" 
  ) 
 
  (action_tile 
    "poutput" 
    "(setq poutput $value)" 
  ) 
 
  (action_tile 
    "po_b" 
    "(setq poutput (getpath)) (set_tile "poutput" poutput)" 
  ) 
 
  (action_tile 
    "oow" 
    "(alert "加锁后的文件无法恢复，请慎重!!!") (mode_tile "out" 1) (setq ow 1)" 
  ) 
 
  (action_tile 
    "osa" 
    "(mode_tile "out" 0) (setq ow 0)" 
  ) 
 
  (action_tile "lockp" "(setq lockp (atoi $value))") 
 
 
  (action_tile "cancel" "(done_dialog 0)") 
  (action_tile "lock" "(done_dialog 4)") 
 
 
  (defun beginlock (/ fl1 n app filename ms of om ds cmd) 
    (if        (and filelist (= ow 0)) 
      (progn 
        (if (not (vl-file-directory-p poutput)) 
          (acet-file-mkdir poutput) 
        ) 
        (setq fl1 '() 
              n          (strlen pinput) 
        ) 
        (foreach x filelist 
          (setq fl1 (cons (strcat poutput (substr x (1+ n))) fl1)) 
        ) 
        (setq savelist (reverse fl1)) 
 
        (mapcar        '(lambda (x y) 
                   (acet-file-copy x y T) 
                 ) 
                filelist 
                savelist 
        ) 
        (setq filelist savelist) 
        (setq scrfile (strcat poutput "\" "TW_batchlock.scr")) 
      ) 
      (setq scrfile (strcat pinput "\" "TW_batchlock.scr")) 
    ) 
 
    (if        filelist 
      (progn 
        (setq scrname (open scrfile "w")) 
        (setq lockfile "lockms.lsp") 
        (foreach x filelist 
          (setq        scr (strcat "open " 
                            x 
                            " " 
                            "(load " 
                            (chr 34) 
                            lockfile 
                            (chr 34) 
                            ")" 
                            " qsave close " 
                    ) 
          ) 
          (write-line scr scrname) 
        ) 
        (close scrname) 
        (command "script" scrfile) 
        (princ) 
      ) 
    ) 
  ) 
 
  (setq what (start_dialog)) 
 
  (cond 
    ((= what 4) (beginlock)) 
    ((= what 0) (exit)) 
  ) 
 
  (unload_dialog dcl_id) 
 
) 
 
 
  [/FONT]

这只是初期产品，锁定图纸空间部分还未写。

对话框预览

haijiangl · 发表于 2006-8-24 17:59:00

大包下载吧，不要钱

agang198 · 发表于 2006-8-29 18:14:06

我用lochup加密DWG文件有个问题：
若只加密模型空间，一切都好。
若还有加密图纸空间，麻烦来了：加密后的图纸空间每回打开都要等很久很久，没法等，也就没法用了。所以只能加密模型空间。

雨箭风刀 · 发表于 2006-8-30 00:09:28

试试看
炸开嵌套块。
如果执行完程序，还没有恢复。可用普通explode命令再炸.可炸开。

wudongfeng001 · 发表于 2008-6-6 21:42:08

我在网上找来好久，知道有smartlock 及dwglock,可是前者需注册，而且花钱很多！！！

wcj70 · 发表于 2008-6-17 00:28:38

xiexie

auw12 · 发表于 2008-6-17 10:26:05

非常感谢

wangxj2002 · 发表于 2008-7-2 16:43:32

支持一下！谢谢啦！！

hcgg · 发表于 2008-7-3 15:47:30

支持下

zscy · 发表于 2008-7-4 12:51:21

强烈支持，找这东东好久了

userzhluserzhl · 发表于 2008-7-5 16:23:53

楼主，可不可以做一个反操作的呢？

chumo · 发表于 2008-7-8 20:31:09

好东西,下在看下了

yezhy001 · 发表于 2008-7-9 18:13:01

没有RMB呀，我的钱呀

95021glq · 发表于 2008-7-11 10:28:00

感性趣

cadmap · 发表于 2008-7-17 23:03:33

楼主,如何解密啊

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

[LISP程序]：自编的dwg批量锁定程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子