Jump to content

Copy Named Views


MKearney028

Recommended Posts

Alright guys, you're up. I've gotten a lot out of this site, so here's giving back. One thing that AutoCAD refuses to give us (as far as I know) is the ability to copy named views. I work on long projects that can carry over 20 named views and it's a lot easier to work in the cut sheets if the named views are there. Well, here you go. The program will let you create the named views, export them (to a .scr file) and then import that file. It doesn't really import them, it actually recreates them the same way they were originally created. Therefore, the settings may not be how you need them, but the coding can be easily edited.

 

Let's see who can make this better. I'm sure there is redundancy, but it does what I need it to.

 

Also, I can't get the ExportViews it to end clean, it always tells me it's ending with a bad function. I'm sure it's just trying to run a return value, but it works.

 

One other thing, is there a way to run a script quietly? Again, it works, just doesn't look as pretty as it could.

 

There's also no error trapping once you run it. I added a dialog box to remind users of a couple things that will cause errors, but nothing else.

 

So without further ado, here you go:

 

;;;Code created by Matt Kearney 3/2012 

;;;CreateViews will allow to set a 3 point UCS or use existing and create a new named view
;;;ExportViews will export the data for all named views to a script file to be run in another drawing
;;;ImportViews will run the script file created from ExportViews (technically, it will freeze all layers and run any script file)


;;;THIS PROGRAM IS PROVIDED TO ALL FOR FREE. ANY MODIFICATIONS AND REPRODUCTIONS
;;;ARE ALLOWED. PLEASE GIVE CREDIT WHEN USING OR REFERENCING THIS PROGRAM. THIS 
;;;PROGRAM IS OFFERED 'AS-IS' WITH NO IMPLIED WARRANTIES OR GUARANTEES.


;;;Dialog box info from http://www.afralisp.net/archive/lisp/acet-utils.htm and Kerry Brown on CADTutor.net forums
;;;Started with ViewsIO.lsp from www.JTBworld.com (changed almost everything, but thank you still)


(vl-load-com)


;CREATEVIEW
;Choose 3 point UCS or keep existing, then window for named view
(defun C:CREATEVIEW (/ cview pt1 pt2)
 (setq v (getstring T "Enter view name to save:"))
 (setq cview (getvar 'viewsize))
 (SETQ	reply (ACET-UI-MESSAGE
	"Create a new UCS?"
	"UCS"
	(+ Acet:YESNOCANCEL Acet:ICONQUESTION)
      )
 )
 ;; Cancel = 2
 ;; Yes = 6
 ;; No = 7
 (IF (= reply 6)				;;if yes
   (progn (command "UCS"			;;create a 3 point ucs by picking points
	    3
	    (setq pt1 (getpoint))
	    (setq pt2 (getpoint))
	    pause
	    "UCS"
	    "S"
	    v
   )					;;Sets UCS and saves it
   (command "plan"
	    ""
	    "_.zoom"
	    "C"
	    (/ (distance pt1 pt2) 2.0)
	    cview
   )
 					;;Rotates view and keeps zoom (close enough)
   )
   (IF	(= reply 7)				;;if no
     (PROGN
(setvar "EXPERT" 4)			;;ignore error if named ucs exists
(COMMAND "UCS" "S" V)			;;name current UCS
(setvar "expert" 0)			;;return expert value to 0
     )
     (QUIT)
   )						;;Quit on cancel
 )						;;end dialog

 (command "_.zoom" "W" (getpoint) (getpoint))	;;Zooms to view
 (command "_.view" "S" V)			;;Save view with name provided
 (command "_.view" "E" "L" v "D" "" "R" v)	;;Makes sure layer state is not saved and restore view created
 (princ)
)						;;End Create View



;;ExportViews
;;Choose file to export view info to
(defun c:ExportViews (/ fn)
 (setq ce (getvar "CMDECHO"))

 ;;Insert the following to create a yes/no/cancel dialog box
 (SETQ	reply (ACET-UI-MESSAGE
	"Do All Views Have A Named UCS?"
	"Named UCS"
	(+ Acet:YESNOCANCEL Acet:ICONWARNING)
      )
 )
 ;; Yes = 6
 ;; No = 7
 ;; Cancel = 2
 (IF (= reply 6)
   (
    (setvar "cmdecho" 0)
     (command "layerpmode" "ON")					;;Make sure layerp is set to on
     (command "_.layer" "OFF" "*" "y" "F" "*" "")			;;Turn off and freeze all layers to run faster
     (if (setq	fn
	 (getfiled "Export views to"
		   (strcat (getvar "dwgprefix")			;;Use drawing name to create script file
			   (vl-filename-base (getvar "dwgname"))
			   "_VIEWS.scr"				;;Add _Views to file name for script
		   )
		   "scr"					;;use extension .scr
		   1						;;Create new file
	 )
  )
(ExportViews fn)						;;Run ExportViews as defined below
     )
     (command "layerp")
     (setvar "cmdecho" ce)
     (princ)
   )									;end Yes Reply
   (IF	(= reply 7)
     (PROGN
(ALERT "Set All Views With A Named UCS Before Proceeding.")	;;"No" response
     )
   )									;;Do nothing on cancel
 )
 (princ)
)



;;ImportViews
;;Choose file with view info to import
(defun c:ImportViews (/ fn)
 (setq ce (getvar "CMDECHO"))
 (setvar "cmdecho" 0)
 (command "layerpmode" "ON")						;;Make sure layerp is set to on
 (command "_.layer" "OFF" "*" "y" "F" "*" "")				;;Turn off and freeze all layers to run faster
 (if (setq fn
     (getfiled "Select Exported Views..."			;;Choose file to import from
	       (getvar "dwgprefix")				;;Start in same folder as current drawing
	       "scr"						;;Make sure it's a scr file
	       8						;;(I'm not positive what this does, but it works)
     )
     )
   (command "script" fn)						;;Run script provided
 )
 (command "layerp")							;;Return layers to previous state (doesn't always work, too many commands between?)
 (setvar "cmdecho" ce)							;;Return Command echo
 (princ)
)



;;;ExportViews programming
;;;This will not work views with a width or height over 1x10^5 units. Add RTOS command to remaining variables if you need it to.
;;;Layer state is not saved with each view (company standard)

(defun ExportViews (fn	 /    vx   vy	vcxw vcyw ucso x1w  x2w	 y1w
	    y2w	 x3w  y3w  vcx	vcy  x1	  x2   y1   y2	 vqty
	    vlist	 f    vdata
	   )
 (while (setq vqty (tblnext "VIEW" (null vqty)))				;;Get View info and run following for each
   (setq vlist (cons (cdr (assoc 2 vqty)) vlist))				;;create a list with each view name
 )
 (setq f (open fn "w"))						;;Open scr file for writing
 (if f
   (progn
     (princ "Following views exported:\n")
     (foreach view vlist
(setq vdata (entget (tblobjname "view" view)))
(command "_.view" "r" view)					;;Restore view to get info
(command "ucs" "NA" "R" view)					;;Be sure UCS is correct and named
(setq vy   (getvar "VIEWSIZE")					;;Set view height
      vx   (* (getvar "viewsize")				;;Do some math to set view width
	      (/ (car (getvar "SCREENSIZE"))
		 (cadr (getvar "SCREENSIZE"))
	      )
	   )
      ucso (getvar "ucsorg")					;;set UCS origin
      vcxw (rtos (car (trans (getvar "viewctr") 1 0)) 2 12)	;;set view center x coordinate in world (keep 12 digits to avoid truncated numbers)
      vcyw (rtos (cadr (trans (getvar "viewctr") 1 0)) 2 12)	;;set view center y coordinate in world
      vcx  (car (getvar "viewctr"))				;;set view center x coordinate in view UCS
      vcy  (cadr (getvar "viewctr"))				;;set view center y coordinate in view UCS
      x1   (- vcx (/ vx 2))					;;set left coordinate in view UCS
      x2   (+ vcx (/ vx 2))					;;set right coordinate in view UCS
      y1   (- vcy (/ vy 2))					;;set bottom coordinate in view UCS
      y2   (+ vcy (/ vy 2))					;;set top coordinate in view UCS
      x1w  (rtos (car ucso) 2 12)				;;set UCS origin x coordinate in world
      x2w  (rtos (car (trans (list '10 '0 '0) 1 0)) 2 12)	;;set first UCS x point in world (+10 in x direction)
      x3w  (rtos (car (trans (list '0 '10 '0) 1 0)) 2 12)	;;set second UCS x point in world
      y1w  (rtos (cadr ucso) 2 12)				;;set UCS origin y coordinate in world
      y2w  (rtos (cadr (trans (list '10 '0 '0) 1 0)) 2 12)	;;set first UCS y point in world
      y3w  (rtos (cadr (trans (list '0 '10 '0) 1 0)) 2 12)	;;set second UCS y point in world (+10 in y direction)
)								;;End setq


;;;Write script for each View
(princ ";Create View " f)(princ view f)(princ "\n" f)		;;Comment line to state view
(princ "(command \"UCS\" \"W\")\n" f)				;;Set UCS to world
(princ "(setq vy " f)(princ vy f)				;;Start setq and add variables from above
(princ " vx " f)(princ vx f)
(princ " vcxw " f)(princ vcxw f)
(princ " vcyw " f)(princ vcyw f)
(princ " x1w " f)(princ x1w f)
(princ " x2w " f)(princ x2w f)
(princ " x3w " f)(princ x3w f)
(princ " y1w " f)(princ y1w f)
(princ " y2w " f)(princ y2w f)
(princ " y3w " f)(princ y3w f)
(princ " vcx " f)(princ vcx f)
(princ " vcy " f)(princ vcy f)
(princ " x1 " f)(princ x1 f)
(princ " x2 " f)(princ x2 f)
(princ " y1 " f)(princ y1 f)
(princ " y2 " f)(princ y2 f)
(princ " view \"" f)(princ view f)
(princ "\")\n" f)						;;End setq

(princ
  "(command \"UCS\" \"3\" (list x1w y1w '0) (list x2w y2w '0) (list x3w y3w '0))\n(command \"UCS\" \"NA\" \"S\" view)\n"
  f
)								;;create a 3 point UCS and name it

(princ "(command \"plan\" \"\")" f)				;;set view to named UCS
(princ
  "(command \"_.zoom\" \"W\" (list x1 y2) (list x2 y1))\n(command \"_.view\" \"s\" view)\n(command \"_.view\" \"E\" \"L\" view \"D\" \"\" \"R\" view)"
  f
)								;;Zoom window to view coordinates, save view as named, make sure layer state is not saved
(princ "\n\;\;\;\n\;\;\;\n" f)					;;End script for view, add comment lines to separate next
(prin1 view)							;;List view in command line as exported
(terpri)
     )
     (close f)								;;close script file that was being written
   )									;;End progn
 )									;;End If
 (princ)
)									;;End ExportViews programming

 

createandcopyviews.lsp

(I'm not sure if it's better to write it or attach it, so I did both.)

 

-Matt

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...