锁定图纸，希望不能再编辑
本帖最后由 自贡黄明儒 于 2012-12-4 09:20 编辑;;有时候，我们并不希望别人修改我们的图纸，说起原因，那就是一段伤心的往事了。
;;今在网上下载了一个程序，试了一下，还行。其原理我不知道。但操作起来很麻烦，得不断
;;回答Yes/No，于是我去掉了许多选项，一键搞定，大家看看这样的修改行不行？
;;有时候，我们并不希望别人修改我们的图纸，说起原因，那就是一段伤心的往事了。
;;今在网上下载了一个程序，试了一下，还行。其原理我不知道。但操作起来很麻烦，得不断
;;回答Yes/No，于是我去掉了许多选项，一键搞定，大家看看这样的修改行不行？
;;By: John D. Chapman自贡黄明儒 2012.12.4
(defun C:Lockup (/ CDIA CMD FDIA PROXYS #SPIN)
;;1 处理代理
(defun proxy (/ PLIST SSET WSSET)
(setq plist '((-4 . "<OR")
(0 . "ACAD_PROXY_ENTITY")
(0 . "AECC_*")
(0 . "AEC_*")
(0 . "AECS_*")
(0 . "RTEXT")
(-4 . "OR>")
)
)
(if (setq sset (ssget "x" plist))
(goexp sset) ;爆破代理
)
(if (setq wsset (ssget "x" (list '(0 . "wipeout"))))
(goerase wsset)
)
)
;;2 爆破代理
(defun goexp (sset / CNT)
(repeat (setq CNT (sslength sset))
(command "_explode" (ssname sset (setq CNT (1- CNT))))
(spin "Exploding..")
)
)
;;3 删除
(defun goerase (wsset / WCNT)
(repeat (setq WCNT (sslength wsset))
(entdel (ssname wsset (setq WCNT (1- WCNT))))
(spin "Erasing..")
)
)
;;4
(defun getlayers (/ LAYLIST LYR)
(while (setq lyr (tblnext "layer" (null lyr)))
(if
(and (member (cdr (assoc 62 lyr)) (list 8 9 251 252 253 254 255))
(not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
)
(if laylist
(setq laylist (strcat laylist "," (cdr (assoc 2 lyr))))
(setq laylist (cdr (assoc 2 lyr)))
)
)
)
laylist
)
;;5
(defun backblk (Mins/ A BAC BC BLISTCLIPENT
ENTENT2 ENT3 N NAMEBPT SSETB
SUBENT VIEWSSET
)
(setq blist (list '(-4 . "<NOT")
'(-4 . "<OR")
'(0 . "SOLID")
'(2 . "SOLID")
'(0 . "VIEWPORT")
'(-4 . "OR>")
'(-4 . "NOT>")
'(-4 . "<OR")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
)
)
(setq ssetb (ssget "X" blist))
(if (setq viewsset (ssget "X" '((0 . "VIEWPORT"))))
(repeat (setq n (sslength viewsset))
(if (setq clipent
(assoc 340 (entget (ssname viewsset (setq n (1- n)))))
)
(ssdel (cdr clipent) ssetb)
)
)
)
(if ssetb
(progn
(setq pt (list 0.0 0.0))
(entmake ;;write block header
(list '(0 . "BLOCK")
'(2 . "*anon")
'(70 . 1)
(cons '10 pt)
)
)
;;add entities in selection set to block
;;repeat for every entity in the selection set
(setq a 0)
(repeat (sslength ssetb)
(setq ent2 (entmake (entget (setq ent (ssname ssetb a)))))
(if (null ent2)
(princ (entget (setq ent (ssname ssetb a))))
)
;;if polyline or block reference with attributes,
;;walk down sub-entities until seqend is found
(if (assoc 66 (entget ent))
(progn
;;add sub-entities until seqend is found
(setq subent (entnext ent))
(while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
(entmake (entget subent))
(setq subent (entnext subent))
)
;;add seqend sub-entity
(setq ent3 (entmake (entget subent)))
(if (null ent3)
(princ (entget subent))
)
)
)
;;delete original entity
(entdel ent)
(setq a (1+ a))
(spin "Making Block of background colours..")
)
(setq nameb (entmake '((0 . "endblk"))))
;;write block end sub-entity
(princ "\nInserting...\n")
;; Insert block reference at insertion point
;; Note: Check the argument Mins for the method to insert the block
;; Note: Mins=T means minsert the block, and Mins=nil means insert it.
(if Mins
;;Minsert block reference at insertion point
(entmake
(list '(0 . "INSERT")
(CONS '100 "AcDbMInsertBlock")
(CONS '70 2)
(CONS '71 2)
(cons '2 nameb)
(cons '10 pt)
)
)
(entmake
(list '(0 . "INSERT")
(cons '2 nameb)
(cons '10 pt)
)
)
;;Insert block reference at insertion point
)
(setq bc (entlast))
(setq bac "back")
(command "_.draworder" bc "" (strcat "_" bac))
)
)
(princ)
)
;;6
(defun solidblk
(Mins / A BA ENT ENT2 ENT3 NAMES PT SLIST SO SSETS SUBENT)
(setq slist (list '(-4 . "<OR")
'(0 . "SOLID")
'(2 . "SOLID")
'(-4 . "OR>")
)
)
(if (setq ssets (ssget "X" slist))
(progn
(setq pt (list 0.0 0.0))
(entmake ;;write block header
(list '(0 . "BLOCK")
'(2 . "*anon")
'(70 . 1)
(cons '10 pt)
)
)
;;add entities in selection set to block
;;repeat for every entity in the selection set
(setq a 0)
(repeat (sslength ssets)
(setq ent2 (entmake (entget (setq ent (ssname ssets a)))))
(if (null ent2)
(princ (entget (setq ent (ssname ssets a))))
)
;;if polyline or block reference with attributes,
;;walk down sub-entities until seqend is found
(if (assoc 66 (entget ent))
(progn
;;add sub-entities until seqend is found
(setq subent (entnext ent))
(while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
(entmake (entget subent))
(setq subent (entnext subent))
)
;;add seqend sub-entity
(setq ent3 (entmake (entget subent)))
(if (null ent3)
(princ (entget subent))
)
)
)
;;delete original entity
(entdel ent)
(setq a (1+ a))
(spin "Making Block of solids..")
)
(setq names (entmake '((0 . "endblk"))))
;;write block end sub-entity
(princ "\nInserting...\n")
;; Insert block reference at insertion point
;; Note: Check the argument Mins for the method to insert the block
;; Note: Mins=T means minsert the block, and Mins=nil means insert it.
(if Mins
;;Minsert block reference at insertion point
(entmake
(list '(0 . "INSERT")
(CONS '100 "AcDbMInsertBlock")
(CONS '70 2)
(CONS '71 2)
(cons '2 names)
(cons '10 pt)
)
)
(entmake
(list '(0 . "INSERT")
(cons '2 names)
(cons '10 pt)
)
)
;;Insert block reference at insertion point
)
(setq so (entlast))
(setq ba "back")
(command "_.draworder" so "" (strcat "_" ba))
(setq ssets nil)
)
)
(princ)
)
;;7
(defun anonBlock (Mins / A ALIST CLIPENT ENT
ENT2 ENT3 N NAME SSET SUBENT
VIEWSSET
)
(setq alist (list '(-4 . "<NOT")
'(-4 . "<OR")
'(0 . "VIEWPORT")
'(0 . "ACAD_PROXY_ENTITY")
'(0 . "AECC_*")
'(0 . "AEC_*")
'(0 . "AECS_*")
'(0 . "RTEXT")
'(0 . "WIPEOUT")
'(0 . "SOLID")
'(2 . "SOLID")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
'(-4 . "NOT>")
)
)
(if (setq viewsset (ssget "X" '((0 . "VIEWPORT"))))
(repeat (setq n (sslength viewsset))
(if (setq clipent
(assoc 340 (entget (ssname viewsset (setq n (1- n)))))
)
(ssdel (cdr clipent) sset)
)
)
)
(if (setq sset (ssget "X" alist))
(progn
(entmake ;;write block header
(list '(0 . "BLOCK")
'(2 . "*anon")
'(70 . 1)
(cons '10 (list 0.0 0.0))
)
)
;;add entities in selection set to block
;;repeat for every entity in the selection set
(setq a 0)
(repeat (sslength sset)
(setq ent2 (entmake (entget (setq ent (ssname sset a)))))
(if (null ent2)
(princ (entget (setq ent (ssname sset a))))
)
;;if polyline or block reference with attributes,
;;walk down sub-entities until seqend is found
(if (assoc 66 (entget ent))
(progn
;;add sub-entities until seqend is found
(setq subent (entnext ent))
(while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
(entmake (entget subent))
(setq subent (entnext subent))
)
;;add seqend sub-entity
(setq ent3 (entmake (entget subent)))
(if (null ent3)
(princ (entget subent))
)
)
)
;;delete original entity
(entdel ent)
(setq a (1+ a))
(spin "Making Block..")
)
(setq name (entmake '((0 . "endblk"))))
;;write block end sub-entity
(princ "\nInserting Block..\n")
;; Insert block reference at insertion point
;; Note: Check the argument Mins for the method to insert the block
;; Note: Mins=T means minsert the block, and Mins=nil means insert it.
(if Mins
;;Minsert block reference at insertion point
(entmake
(list '(0 . "INSERT")
(CONS '100 "AcDbMInsertBlock")
(CONS '70 2)
(CONS '71 2)
(cons '2 name)
(cons '10 (list 0.0 0.0))
)
)
(entmake
(list '(0 . "INSERT")
(cons '2 name)
(cons '10 (list 0.0 0.0))
)
)
;;Insert block reference at insertion point
)
)
)
(princ)
)
;;8
(defun spin (wh)
(prompt (strcat "\r"
wh
(cond ((= #spin "|") (setq #spin "/"))
((= #spin "/") (setq #spin "-"))
((= #spin "-") (setq #spin "\\"))
(T (setq #spin "|"))
)
)
)
(princ)
)
;;9 本程序主程序
(setq cmd (getvar "cmdecho")
fdia (getvar "filedia")
cdia (getvar "cmddia")
proxys (getvar "proxyshow")
)
(command "UNDO" "Begin")
(setvar "cmdecho" 0)
(setvar "filedia" 0)
(setvar "cmddia" 0)
(command "undo" "mark")
(command "-layer" "make" "LOCKUP" "")
(command "color" "bylayer")
(setvar "proxyshow" 0)
(command "regen")
(proxy)
(anonBlock nil) ; make anon insert in named layout
(backblk nil) ; make anon insert in named layout
(solidblk nil) ; make anon insert in named layout
(anonBlock T) ; make anon minsert in named layout
(command "zoom" "extents")
(command "UNDO" "End")
(setvar "cmdecho" cmd)
(setvar "filedia" fdia)
(setvar "cmddia" cdia)
(setvar "proxyshow" proxys)
(princ "\n 图纸已经锁定，使其不能修改。")
(princ)
)
;;原程序
;;;Lockup.lsp - Locks all selected entities (except proxy objects) within a drawing.
;;;By: John D. Chapman
;;;With help from: Stig Madsen, Celie Dailey, Pat Starkey.
;;;Based on and expanded from AB.lsp by Brian Debelius (Make/Insert an Anonymous Block)
;;;and AB-Minsert.lsp by Rick McElvain (Make/MINSERT an Anonymous Block).
;;;Inspiration from Adam Conrath (MINSERT).
;;;Special mention to Jim Fisher.
;;;Last Revisions:
;;;March 5, 2002:- Separate block made of solids before main routine runs.
;;;March 7, 2002:- Separate Block made of background colours (8,9,251-255).
;;;March 22, 2002: - Improved error trapping.
;;;This routine turns on, thaws, and unlocks all layers before it starts the lock.
;;;The state of your layers prior to running LOCKUP will be restored
;;;in AutoCAD 2000i only.
;;;_______________________________________________________________________________________
(alert
"\nDO NOT RUN LOCKUP ON AN ORIGINAL DRAWING.
\n RUN ONLY ON A COPY OF THE ORIGINAL."
)
(alert
"\nLockup2.lsp - By John D. Chapman - Ainley and Associates Ltd.
\nwith thanks to Brian Debelius, Adam Conrath, Rick McElvain,
\n Stig Madsen, Celie Dailey, Pat Starkey, Jim Fisher
\n and the Autodesk User Group International."
)
(defun lockerror (msg)
(if (/= msg "Function cancelled")
(princ
(strcat "\nError: " msg " [" (itoa (getvar "ERRNO")) "]")
)
(princ)
)
(command "UNDO" "End")
(Abort "\nLockup was interrupted. Function Aborted!")
(setq *error* olderr)
(princ)
)
(defun Abort (msg)
(setvar "filedia" fdia)
(setvar "cmddia" cdia)
(setvar "cmdecho" cmd)
(alert msg)
)
;;Exit
(defun getlayers ()
(setq lyr (tblnext "layer" t))
(setq laylist "")
(while lyr
(if (or (and (= (cdr (assoc 62 lyr)) 8)
(not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
)
(and (= (cdr (assoc 62 lyr)) 9)
(not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
)
(and (= (cdr (assoc 62 lyr)) 251)
(not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
)
(and (= (cdr (assoc 62 lyr)) 252)
(not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
)
(and (= (cdr (assoc 62 lyr)) 253)
(not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
)
(and (= (cdr (assoc 62 lyr)) 254)
(not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
)
(and (= (cdr (assoc 62 lyr)) 255)
(not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
)
)
(if (equal laylist "")
(setq laylist (strcat laylist (cdr (assoc 2 lyr))))
(setq laylist (strcat laylist "," (cdr (assoc 2 lyr))))
)
)
(setq lyr (tblnext "layer"))
)
laylist
)
(defun backblk (layoutName Mins)
(if layoutName
(cond
((= layoutName "14MS")
(setq blist (list '(-4 . "<NOT")
'(-4 . "<OR")
'(67 . 1)
'(0 . "SOLID")
'(2 . "SOLID")
'(-4 . "OR>")
'(-4 . "NOT>")
'(-4 . "<OR")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
)
)
)
((= layoutName "14PS")
(setq blist (list '(67 . 1)
'(-4 . "<NOT")
'(-4 . "<OR")
'(0 . "SOLID")
'(2 . "SOLID")
'(0 . "VIEWPORT")
'(-4 . "OR>")
'(-4 . "NOT>")
'(-4 . "<OR")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
)
)
)
(T
(setq blist (list (cons 410 layoutName)
'(-4 . "<NOT")
'(-4 . "<OR")
'(0 . "SOLID")
'(2 . "SOLID")
'(0 . "VIEWPORT")
'(-4 . "OR>")
'(-4 . "NOT>")
'(-4 . "<OR")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
)
)
)
)
(setq blist (list '(-4 . "<NOT")
'(-4 . "<OR")
'(0 . "SOLID")
'(2 . "SOLID")
'(0 . "VIEWPORT")
'(-4 . "OR>")
'(-4 . "NOT>")
'(-4 . "<OR")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
)
)
)
(setq ssetb (ssget "X" blist))
(setq viewsset (ssget "X" '((0 . "VIEWPORT"))))
(if viewsset
(progn
(setq n 0)
(repeat (sslength viewsset)
(if (setq clipent (assoc 340 (entget (ssname viewsset n))))
(ssdel (cdr clipent) ssetb)
)
(setq n (1+ n))
)
)
)
(if ssetb
(progn
(setq pt (list 0.0 0.0))
(entmake ;;write block header
(list '(0 . "BLOCK")
'(2 . "*anon")
'(70 . 1)
(cons '10 pt)
)
)
;;add entities in selection set to block
;;repeat for every entity in the selection set
(setq a 0)
(repeat (sslength ssetb)
(setq ent2 (entmake (entget (setq ent (ssname ssetb a)))))
(if (null ent2)
(princ (entget (setq ent (ssname ssetb a))))
)
;;if polyline or block reference with attributes,
;;walk down sub-entities until seqend is found
(if (assoc 66 (entget ent))
(progn
;;add sub-entities until seqend is found
(setq subent (entnext ent))
(while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
(entmake (entget subent))
(setq subent (entnext subent))
)
;;add seqend sub-entity
(setq ent3 (entmake (entget subent)))
(if (null ent3)
(princ (entget subent))
)
)
)
;;delete original entity
(entdel ent)
(setq a (1+ a))
(c:spin "Making Block of background colours..")
)
(setq nameb (entmake '((0 . "endblk"))))
;;write block end sub-entity
(princ "\nInserting...\n")
;; Insert block reference at insertion point
;; Note: Check the argument Mins for the method to insert the block
;; Note: Mins=T means minsert the block, and Mins=nil means insert it.
(if Mins
;;Minsert block reference at insertion point
(entmake
(list '(0 . "INSERT")
(CONS '100 "AcDbMInsertBlock")
(CONS '70 2)
(CONS '71 2)
(cons '2 nameb)
(cons '10 pt)
)
)
(entmake
(list '(0 . "INSERT")
(cons '2 nameb)
(cons '10 pt)
)
)
;;Insert block reference at insertion point
)
(setq bc (entlast))
(setq bac "back")
(command "_.draworder" bc "" (strcat "_" bac))
(setq ssetb nil)
(setq viewsset nil)
)
)
(princ)
)
(defun solidblk (layoutName Mins)
(if layoutName
(cond
((= layoutName "14MS")
(setq slist (list '(-4 . "<NOT") '(67 . 1)
'(-4 . "NOT>") '(-4 . "<OR")
'(0 . "SOLID") '(2 . "SOLID")
'(-4 . "OR>")
)
)
)
((= layoutName "14PS")
(setq slist (list '(67 . 1) '(-4 . "<OR") '(0 . "SOLID") '(2 . "SOLID")
'(-4 . "OR>"))
)
)
(T
(setq slist (list (cons 410 layoutName)
'(-4 . "<OR")
'(0 . "SOLID")
'(2 . "SOLID")
'(-4 . "OR>")
)
)
)
)
(setq slist (list '(-4 . "<OR")
'(0 . "SOLID")
'(2 . "SOLID")
'(-4 . "OR>")
)
)
)
(setq ssets (ssget "X" slist))
(if ssets
(progn
(setq pt (list 0.0 0.0))
(entmake ;;write block header
(list '(0 . "BLOCK")
'(2 . "*anon")
'(70 . 1)
(cons '10 pt)
)
)
;;add entities in selection set to block
;;repeat for every entity in the selection set
(setq a 0)
(repeat (sslength ssets)
(setq ent2 (entmake (entget (setq ent (ssname ssets a)))))
(if (null ent2)
(princ (entget (setq ent (ssname ssets a))))
)
;;if polyline or block reference with attributes,
;;walk down sub-entities until seqend is found
(if (assoc 66 (entget ent))
(progn
;;add sub-entities until seqend is found
(setq subent (entnext ent))
(while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
(entmake (entget subent))
(setq subent (entnext subent))
)
;;add seqend sub-entity
(setq ent3 (entmake (entget subent)))
(if (null ent3)
(princ (entget subent))
)
)
)
;;delete original entity
(entdel ent)
(setq a (1+ a))
(c:spin "Making Block of solids..")
)
(setq names (entmake '((0 . "endblk"))))
;;write block end sub-entity
(princ "\nInserting...\n")
;; Insert block reference at insertion point
;; Note: Check the argument Mins for the method to insert the block
;; Note: Mins=T means minsert the block, and Mins=nil means insert it.
(if Mins
;;Minsert block reference at insertion point
(entmake
(list '(0 . "INSERT")
(CONS '100 "AcDbMInsertBlock")
(CONS '70 2)
(CONS '71 2)
(cons '2 names)
(cons '10 pt)
)
)
(entmake
(list '(0 . "INSERT")
(cons '2 names)
(cons '10 pt)
)
)
;;Insert block reference at insertion point
)
(setq so (entlast))
(setq ba "back")
(command "_.draworder" so "" (strcat "_" ba))
(setq ssets nil)
)
)
(princ)
)
(defun anonBlock (layoutName Mins)
(if layoutName
(cond
((= layoutName "14MS")
(setq alist (list '(-4 . "<NOT")
'(-4 . "<OR")
'(67 . 1)
'(0 . "ACAD_PROXY_ENTITY")
'(0 . "AEC_*")
'(0 . "AECS_*")
'(0 . "RTEXT")
'(0 . "WIPEOUT")
;;'(8 . "LAYCFG")
'
(0 . "SOLID")
'(2 . "SOLID")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
'(-4 . "NOT>")
)
)
)
((= layoutName "14PS")
(setq alist (list '(67 . 1)
'(-4 . "<NOT")
'(-4 . "<OR")
'(0 . "VIEWPORT")
'(0 . "ACAD_PROXY_ENTITY")
'(0 . "AEC_*")
'(0 . "AECS_*")
'(0 . "RTEXT")
'(0 . "WIPEOUT")
;;'(8 . "LAYCFG")
'
(0 . "SOLID")
'(2 . "SOLID")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
'(-4 . "NOT>")
)
)
)
(T
(setq alist (list (cons 410 layoutName)
'(-4 . "<NOT")
'(-4 . "<OR")
;;'(8 . "LAYCFG")
'
(0 . "VIEWPORT")
'(0 . "ACAD_PROXY_ENTITY")
'(0 . "AECC_*")
'(0 . "AEC_*")
'(0 . "AECS_*")
'(0 . "RTEXT")
'(0 . "WIPEOUT")
'(0 . "SOLID")
'(2 . "SOLID")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
'(-4 . "NOT>")
)
)
)
)
(setq alist (list '(-4 . "<NOT")
'(-4 . "<OR")
;;'(8 . "LAYCFG")
'
(0 . "VIEWPORT")
'(0 . "ACAD_PROXY_ENTITY")
'(0 . "AECC_*")
'(0 . "AEC_*")
'(0 . "AECS_*")
'(0 . "RTEXT")
'(0 . "WIPEOUT")
'(0 . "SOLID")
'(2 . "SOLID")
(cons 8 (getlayers))
'(62 . 8)
'(62 . 9)
'(62 . 251)
'(62 . 252)
'(62 . 253)
'(62 . 254)
'(62 . 255)
'(-4 . "OR>")
'(-4 . "NOT>")
)
)
)
(setq sset (ssget "X" alist))
(setq viewsset (ssget "X" '((0 . "VIEWPORT"))))
(if viewsset
(progn
(setq n 0)
(repeat (sslength viewsset)
(if (setq clipent (assoc 340 (entget (ssname viewsset n))))
(ssdel (cdr clipent) sset)
)
(setq n (1+ n))
)
)
)
(if sset
(progn
(setq pt (list 0.0 0.0))
(entmake ;;write block header
(list '(0 . "BLOCK")
'(2 . "*anon")
'(70 . 1)
(cons '10 pt)
)
)
;;add entities in selection set to block
;;repeat for every entity in the selection set
(setq a 0)
(repeat (sslength sset)
(setq ent2 (entmake (entget (setq ent (ssname sset a)))))
(if (null ent2)
(princ (entget (setq ent (ssname sset a))))
)
;;if polyline or block reference with attributes,
;;walk down sub-entities until seqend is found
(if (assoc 66 (entget ent))
(progn
;;add sub-entities until seqend is found
(setq subent (entnext ent))
(while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
(entmake (entget subent))
(setq subent (entnext subent))
)
;;add seqend sub-entity
(setq ent3 (entmake (entget subent)))
(if (null ent3)
(princ (entget subent))
)
)
)
;;delete original entity
(entdel ent)
(setq a (1+ a))
(c:spin "Making Block..")
)
(setq name (entmake '((0 . "endblk"))))
;;write block end sub-entity
(princ "\nInserting Block..\n")
;; Insert block reference at insertion point
;; Note: Check the argument Mins for the method to insert the block
;; Note: Mins=T means minsert the block, and Mins=nil means insert it.
(if Mins
;;Minsert block reference at insertion point
(entmake
(list '(0 . "INSERT")
(CONS '100 "AcDbMInsertBlock")
(CONS '70 2)
(CONS '71 2)
(cons '2 name)
(cons '10 pt)
)
)
(entmake
(list '(0 . "INSERT")
(cons '2 name)
(cons '10 pt)
)
)
;;Insert block reference at insertion point
)
(setq sset nil)
(setq viewsset nil)
)
;; Note: This statement is just a debug string and can be deleted
(if layoutName
(princ (strcat "\nNo entities to lock in " layoutName))
)
)
(princ)
)
(defun Finish (vers)
(setvar "clayer" cla)
(setvar "tilemode" space)
(if (= vers 2)
(command "-layer" "state" "restore" "lockup" "" "")
)
(command "-layer" "lock" "*" "")
(setvar "proxyshow" 1)
(command "regen")
(cond
((= cont "Yes")
(alert
"\nPaper space only has been locked.
\nTo lock model space, run Lockup
\nagain and do NOT skip to paper space."
)
)
((= answer2 "Model")
(alert "\nAll selected entities have been locked.")
)
((= answer2 nil)
(alert "\nAll selected entities have been locked.")
)
)
(setq cont nil
answer2 nil
)
(princ "\nLockup has completed. ")
(princ)
)
;;; Note:
;;; Separate routine still for r14, because paper space is a whole different
;;; ballgame in later versions. It supplies the keyword "14PS" to be recognized
;;; by anonBlock in order to select all entities that have group code 67 = 1
(defun goLock14PS ()
(setvar "tilemode" 0)
(proxy)
(anonBlock "14PS" nil); make anon insert - on paper space
(backblk "14PS" nil) ; make anon insert - on paper space
(solidBlk "14PS" nil) ; make anon insert - on paper space
(anonBlock "14PS" T) ; make anon minsert - on paper space
(command "zoom" "extents")
(prompt "\nPaper Space has been locked.")
(Finish 0)
)
(defun goLockPS (vers)
(if (= vers 0)
(goLock14PS)
(progn
(princ "\nType in Layout Name to make current: ")
(command "layout" "set" pause) ;type in whatever layout to set current
(while (> (getvar "cmdactive") 0) (command pause))
(proxy)
(anonBlock (getvar "CTAB") nil) ; make anon insert in named layout
(backblk (getvar "CTAB") nil) ; make anon insert in named layout
(solidblk (getvar "CTAB") nil) ; make anon insert in named layout
(anonBlock (getvar "CTAB") T) ; make anon minsert in named layout
(command "zoom" "extents")
(initget "Yes No")
(prompt
(strcat "\nLayout " (getvar "ctab") " has been locked.")
)
(setq answer
(getkword "\nAre there more layouts to lock? Y/<N>: ")
)
(cond
((or (null answer) (= answer "No"))
(Finish vers)
)
((= answer "Yes")
(goLockPS vers)
)
(T nil)
)
)
)
)
(defun goLock (vers)
(setvar "tilemode" 1)
(if (= vers 2)
(command "-layer" "state" "save" "lockup" "" "" "")
)
(command "-layer" "thaw" "*" "on" "*" "unlock" "*" "")
(command "zoom" "extents")
(proxy)
(if (/= vers 0)
(progn
(anonBlock "Model" nil); make anon insert in model space
(backblk "Model" nil); make anon insert in model space
(solidblk "Model" nil); make anon insert in model space
(anonBlock "Model" T); make anon minsert in model space
)
(progn
(anonBlock "14MS" nil)
(backblk "14MS" nil)
(solidblk "14MS" nil)
(anonBlock "14MS" T)
)
)
(prompt "\nModel Space has been locked.")
(initget "Yes No")
(setq answer
(getkword "\nDo you want to lock Paper Space? Y/<N>: ")
)
(cond
((or (null answer) (= answer "No")) (Finish vers))
((= answer "Yes") (goLockPS vers))
(T nil)
)
)
(defun states ()
(if (= vers 2)
(command "-layer" "state" "save" "lockup" "" "" "")
)
(command "-layer" "thaw" "*" "on" "*" "unlock" "*" "")
(command "graphscr")
(command "zoom" "extents")
(goLockps vers)
)
(defun continue ()
(initget "Yes No")
(setq cont (getkword
"\nModel Space will not be locked! Continue? Y/<N>: "
)
)
(cond ((= cont "Yes") (states))
((= cont "No") (skip))
((= cont nil) (skip))
)
)
(defun skip ()
(initget "Skip Model")
(setq answer2
(getkword
"\nStart in Model Space or Skip to Paper Space? Skip/<Model>:"
)
)
(cond ((= answer2 "Skip") (continue))
((= answer2 "Model") (goLock vers))
((= answer2 nil) (goLock vers))
)
)
(defun 14or2k (/ answer)
(initget "14 2000 2000i")
(setq answer
(getkword
"\nWhat version of AutoCAD are you in? 14/2000<2000i>: "
)
)
(cond
((= answer "14") (setq vers 0))
((= answer "2000") (setq vers 1))
((= answer "2000i") (setq vers 2))
((= answer nil) (setq vers 2))
)
(skip)
)
(defun goexp ()
(progn
(repeat (sslength sset)
(command "_explode" (ssname sset CNT))
(setq CNT (1+ CNT))
(c:spin "Exploding..")
)
(alert (strcat "\n " (itoa CNT) " Entities Exploded."))
)
(setq sset nil)
(princ)
)
(defun xpproxy (/ xpl)
(alert
"\n Proxy Entities have been found.
If they are not exploded, they will
be omitted from the lockup process."
)
(initget "Yes No")
(setq xpl (getkword "\nExplode Proxy Entities? Y/<N>: "))
(if (or (= xpl "No") (= xpl nil))
(princ)
)
(if (= xpl "Yes")
(goexp)
)
(princ)
)
(defun goerase ()
(progn
(repeat (sslength wsset)
(entdel (ssname wsset WCNT))
(setq WCNT (1+ WCNT))
(c:spin "Erasing..")
)
(alert (strcat "\n " (itoa WCNT) " Wipeouts Erased."))
)
(setq wsset nil)
(princ)
)
(defun goaskerase (/ del)
(alert
"\n Wipeouts have been found."
)
(initget "Yes No")
(setq del (getkword "\nErase Wipeouts? Y/<N>: "))
(if (or (= del "No") (= del nil))
(princ)
)
(if (= del "Yes")
(goerase)
)
(princ)
)
(defun gowipeout (/ where wlist)
(setq where (getvar "tilemode"))
(setq cs 67)
(if (= where 0)
(setq sp 1)
)
(if (= where 1)
(setq sp 0)
)
(setq wlist (list (cons cs sp)
'(0 . "wipeout")
)
)
(setq WCNT 0)
(setq wsset (ssget "x" wlist))
(if (= wsset nil)
(princ)
)
(if (not (= wsset nil))
(goaskerase)
)
(princ)
)
(defun proxy (/ where plist)
(setq where (getvar "tilemode"))
(if (= where 0)
(setq plist '((-4 . "<NOT")
(67 . 0)
(-4 . "NOT>")
(-4 . "<OR")
(0 . "ACAD_PROXY_ENTITY")
(0 . "AECC_*")
(0 . "AEC_*")
(0 . "AECS_*")
(0 . "RTEXT")
(-4 . "OR>")
)
)
)
(if (= where 1)
(setq plist '((-4 . "<NOT")
(67 . 1)
(-4 . "NOT>")
(-4 . "<OR")
(0 . "ACAD_PROXY_ENTITY")
(0 . "AECC_*")
(0 . "AEC_*")
(0 . "AECS_*")
(0 . "RTEXT")
(-4 . "OR>")
)
)
)
(setq CNT 0)
(setq sset (ssget "x" plist))
(if (= sset nil)
(princ)
)
(if (not (= sset nil))
(xpproxy)
)
(gowipeout)
(princ)
)
(defun c:undolock ()
;;Undo and Reset variables
(setvar "cmdecho" 0)
(princ "\nPlease wait while Lockup is undone.")
(command "undo" "end")
(command "undo" "back")
(setvar "cmdecho" 1)
(setvar "filedia" 1)
(setvar "cmddia" 1)
(setvar "clayer" cla)
(princ "\nLockup has been undone.")
(princ)
)
(defun c:look (/ alist CNT sset)
(setq alist '((-4 . "<OR")
(0 . "ACAD_PROXY_ENTITY")
(0 . "AECC_*")
(0 . "AEC_*")
(0 . "AECS_*")
(0 . "RTEXT")
(0 . "WIPEOUT")
(-4 . "OR>")
)
)
(setq CNT 0)
(if alist
(progn
(setq sset (ssget "X" alist))
(if sset
(repeat (sslength sset)
(setq CNT (1+ CNT))
)
)
(if (= CNT 1)
(alert (strcat "\n " (itoa CNT) " Entity found."))
)
(if (> CNT 1)
(alert (strcat "\n " (itoa CNT) " Entities found."))
)
)
)
(if (= sset nil)
(alert "\nNo Entities were found.")
)
(princ)
)
(defun c:spin (wh)
(prompt (strcat "\r"
wh
(cond ((= sp "|") (setq sp "/"))
((= sp "/") (setq sp "-"))
((= sp "-") (setq sp "\\"))
(T (setq sp "|"))
)
)
)
(princ)
)
(defun C:Lockup (/ start answer)
(setq fdia (getvar "filedia")
cdia (getvar "cmddia")
cmd (getvar "cmdecho")
cla (getvar "clayer")
space (getvar "tilemode")
olderr *error*
*error* lockerror
cont nil
answer2 nil
)
(setvar "cmdecho" 0)
(command "UNDO" "Begin")
(setvar "filedia" 0)
(setvar "cmddia" 0)
(command "undo" "mark")
(command "-layer" "make" "LOCKUP" "")
(command "color" "bylayer")
(setvar "proxyshow" 0)
(command "regen")
(initget "Yes No")
(setq answer
(getkword
"\nThis routine will lock the drawing! Do you really want to proceed? Y/<N>: "
)
)
(cond
((or (= answer "No") (null answer))
(Alert "LOCKUP aborted!")
)
((= answer "Yes") (14or2k))
)
(command "UNDO" "End")
(setq *error* olderr)
(setvar "filedia" fdia)
(setvar "cmddia" cdia)
(setvar "cmdecho" cmd)
(princ)
)
(princ "\nLOCKUP is loaded.")
(princ "\nType LOCKUP to start.")
(princ)
也锁住自己了，不过可以备份，对于有些不守信的人还是有用的。 ssget 列表值错误 位置-> 行:274 列:21 不错的程序，很有用收了 弱弱的问一句楼主：如何解除锁定呢？ haoryh 发表于 2012-12-4 09:08 static/image/common/back.gif
弱弱的问一句楼主：如何解除锁定呢？
说实话，我也不知道
原程序的解锁也只是用undo来解决的
自贡黄明儒 发表于 2012-12-4 09:22 static/image/common/back.gif
说实话，我也不知道
原程序的解锁也只是用undo来解决的
那黄兄写一个得了，光有锁没得钥匙，那不成出了门就回不了家了
RE: 锁定图纸，希望不能再编辑
直接保存为Pdf，当他需要编辑让他自己再转为dwg，这样又保密又方便他人。 没钥匙不敢锁啊 这个就是利用多重块进行加密！这个帖子4楼程序可以解密！
http://bbs.mjtd.com/thread-92160-1-1.html 1、多重块加密好像可以破解的。
2、 用天正的图纸加密好像能破解的少。最后只能转成JPG再转成DWG。这样转回来图纸都成一段段线组成的了 Gu_xl 发表于 2012-12-4 11:05 static/image/common/back.gif
这个就是利用多重块进行加密！
这个帖子4楼程序可以解密！
http://bbs.mjtd.com/thread-92160-1-1.html
你的这个程序确实可以解密，但对于属性块。。。 这是一个过了河拆了桥的主意,实不可取