PANLINE LISP Routine

[plackowski]

Just thought I'd share a routine I created yesterday - I hope others find it useful.

 

Sometimes I run into situations where I need to move portions of my model great distances, and I have to spend a few minutes each time updating the viewport so that my leaders and tags in paperspace line up with the shifted model. The only technique I found was this one, which isn't very practical when I'm moving things a thousand odd feet away.

 

Here's how the LISP works. You go to modelspace and draw a line between the old location and the new one. Then you go to paperspace and enter the viewport you need to update. Simply start the command with "PANLINE", and click on the line. I've also included an option to reverse the pan direction depending on which way you drew the line, and a warning if the viewport is locked.

 

Here's the code:

(defun c:PANLINE ( / lock flag alrt line p1 p2 option)
;Pans from one end of a line to another.
;Useful for updating a viewport when objects in modelspace have been moved.
;Created by Perry Lackowski on 12/22/2016

(VL-LOAD-COM)
(setq lock (VLA-GET-DISPLAYLOCKED (VLA-GET-ACTIVEPVIEWPORT (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))));
(setq alrt (VL-SYMBOL-NAME lock))
(IF (= alrt ":vlax-true")
	(princ "\nCannot pan inside a locked viewport")
	(progn
	;Prevents the rest of the code from running if an active viewport is locked.
	
		(setq flag f)
		(while (not flag)
		 	(setq line (car (entsel "\nSelect Line : ")))
			(cond   (  (null line)					(princ "\nNothing selected, Please try again.")		  )
				(  (= (cdr (assoc 0 (entget line))) "LINE")	(setq flag t)						  )
				(  t						(princ "\nSelected object is not line, Please try again."))
			)
		)

		(setq p1 (cdr (assoc 10 (entget line))))
   		(setq p2 (cdr (assoc 11 (entget line))))
		;retrieves the contents of group codes 10 and 11 which contain the first and second point of the line.
	
		(command ".-pan" p2 p1)

		(princ "Reverse direction [Yes/No] <No>:")
		(initget 6 "Yes or No")
		(setq option (getkword "\nReverse pan direction? (Yes/No) <No>: "))
		(if (= option "Yes")
			(progn
				(command ".-pan" p1 p2)
				(command ".-pan" p1 p2)
			)
		)
	(princ "\nPan complete.")

));end progn/if

(princ)

);end defun

[Grrr]

Good job,

A few remarks if you don't mind:

- There was a discussion that always must allow the user to exit without forcing to hit ESC (and exit with error), so you could change the line prompt loop with this (so by pressing enter you could exit the routine):

(while (not flag)
 (setq line (car (entsel "\nSelect Line <exit> : ")))
 (cond   
   ( (= 7 (getvar 'errno)) (princ "\nNothing selected, Please try again.") (setvar 'errno 0) )
   ( (and line (/= (cdr (assoc 0 (entget line))) "LINE"))	(princ "\nSelected object is not line, Please try again.") )
   (t (setq flag t) )
 )
)

And the below stuff could be:

 

(if line
 (progn
   (setq p1 (cdr (assoc 10 (entget line))))
   (setq p2 (cdr (assoc 11 (entget line))))
   ;retrieves the contents of group codes 10 and 11 which contain the first and second point of the line.
   
   (command "_.-pan" p2 p1)
   
   (initget 6 "Yes No")
   (if (= (setq option (getkword "\nReverse pan direction? [Yes/No] <No>: ")) "Yes")
     (command "_.-pan" p1 p2)
   )
   (princ "\nPan complete.")
 ); progn
); if

-------------------

(setq flag f)

Maybe you ment:

(setq flag nil)

But anyway this line is redundant, since this flag symbol is localised, and is not set to anything.

-------

(setq option (getkword "\nReverse pan direction? (Yes/No) <No>: "))

Note the the type of brackets are used, so this would change the prompt behaviour (wherever you press "N" or "Y" keys).

(setq option (getkword "\nReverse pan direction? [Yes/No] <No>: "))

Hope This Helps.

[plackowski]

Thanks for the valuable input Grrr! I went and implemented all of your changes below:

 

(defun c:PANLINE ( / lock flag alrt line p1 p2 option)
;Pans from one end of a line to another.
;Useful for updating a viewport when objects in modelspace have been moved.
;Created by Perry Lackowski on 12/22/2016

(VL-LOAD-COM)
(setq lock (VLA-GET-DISPLAYLOCKED (VLA-GET-ACTIVEPVIEWPORT (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))));
(setq alrt (VL-SYMBOL-NAME lock))
(IF (= alrt ":vlax-true")
	(princ "\nCannot pan inside a locked viewport")
	(progn
	;Prevents the rest of the code from running if an active viewport is locked.

		(while (not flag)
			(setq line (car (entsel "\nSelect Line <exit> : ")))
			(cond   
				( (= 7 (getvar 'errno)) (princ "\nNothing selected, Please try again.") (setvar 'errno 0) )
				( (and line (/= (cdr (assoc 0 (entget line))) "LINE"))	(princ "\nSelected object is not line, Please try again.") )
				(t (setq flag t) )
			)
		)

		(if line
			(progn
				(setq p1 (cdr (assoc 10 (entget line))))
				(setq p2 (cdr (assoc 11 (entget line))))
				;retrieves the contents of group codes 10 and 11 which contain the first and second point of the line.

				(command ".-pan" p2 p1)

				(princ "Reverse direction (Yes/No) <No>:")
				(initget 6 "Yes or No");initializes the next get function to only accept yes and no
				(setq option (getkword "\nReverse pan direction? [Yes/No] <No>: "))
				(if (= option "Yes")
					(progn
						(command ".-pan" p1 p2)
						(command ".-pan" p1 p2)
					)
				)
				(princ "\nPan complete.")
			)
		)
));end progn/if

(princ)

);end defun