lockup.lsp

dwg加密小程式(LSP) 1

    )
  )
  (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 "\n  Inserting 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 "\n  Paper 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 "\n  Layout " (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 "\n  Model 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)