lockup.lsp

dwg加密小程式(LSP) 1

;;;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.
        \n  with 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 "\n  Inserting...\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 "\n  Inserting...\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>")
		)