AutoLISP: Align Viewports Horizontally

Link to www.autocadtips.wordpress.com

This routine is a gem. It allows you to easily align a viewport to another viewport by snapping to objects within the viewport. It works with viewports that have the same scale and for viewports with different scales applied to them. One tip that will help is to remember how to cycle through the viewports on a layout tab. To do this you use CTRL + R to cycle through the layouts [shown here].

Here’s how:

  • VPALH <enter> to start (ViewPort ALign Horizontal)
  • Select a base point in the viewport to define where you want the other VP to be aligned to.
  • Click inside another viewport to activate it
  • Select a base point within this viewport to be aligned (horizontally) to the first base point

~enjoy

;Shusei Hayashi
;OffshoreCad&Management Inc.
;10F Jaka Bldg., 6780 Ayala Ave.,
;Makati, Philippines
;http://www.offshorecad.com.ph/
;http://www.offshore-management.com.ph/
;Modified and featured by Greg Battin at www.autocadtips.wordpress.com
; modified for english use only and to remove registry stuff
(defun c:VPALH ( / Pt1 VP1 VP2 Pt1P ok Pt2 Pt2P Delta DeltaM ObjSet ObjNameL OpSwitch
Delta theAng ViewName)
(setq OpSwitch 1)
(SD_5202)
)
;***************
(defun SD_5202 ( / )
(princ "\n Viewport Alignment Horizontally")
(princ "\n **********************************")
(setq *error* *myerror*)
(SD1028)
(OnlyLayout_5003)
(AllLock_5202)
(Procedure_5202)
(AllLock_5202)
(SD2056)
(setq *error* nil)
(princ)
)
;***************
(defun Procedure_5202()
(command "._MSPACE")
(setq Pt1 (getpoint "\n Select Basepoint in any Viewport :"))
(setq VP1 (getvar "CVPORT"))
(setq Pt1P (trans Pt1 1 2))
(setq Pt1P (trans Pt1P 2 3))
; (command "PSPACE")
; (checkcircle Pt1P 0.1 "A21")
; (command "MSPACE")
(setq ok nil)
(while (null ok)
(setq Pt2 (getpoint "\n Select Basepoint in Viewport to be adjusted :"))
(setq Pt2P (trans Pt2 1 2))
(setq Pt2P (trans Pt2P 2 3))
(if (/= (setq VP2 (getvar "CVPORT")) VP1)
(setq ok T)
(princ "\n Pick point in different Viewport.")
)
)
(AllUnLock_5202) ;UnLock
;UnLock
(command "._MSPACE")
(setvar "CVPORT" VP2)
(setq ViewName (ssname (ssget "X" '((0 . "VIEWPORT")(68 . 1))) 0))
(cond ((= OpSwitch 1)
(setq Delta (- (cadr Pt1P)(cadr Pt2P)))
(princ "\n Delta : ")
(princ Delta)
(setq theAng (SD3511 51 ViewName))
(princ "\n theAng : ")
(princ theAng)
(setq Delta (* (/ (SD3511 45 ViewName)(SD3511 41 ViewName)) Delta))
(princ "\n Delta : ")
(princ Delta)
(setq DeltaP (trans (SD8446 (list 0 Delta) '(0 0) (* -1.0 theAng)) 0 1))
(princ "\n DeltaP : ")
(princ DeltaP)
(command "._pan" DeltaP "")
)
((= OpSwitch 2)
(setq Delta (- (car Pt1P)(car Pt2P)))
(setq theAng (SD3511 51 ViewName))
(setq Delta (* (/ (SD3511 45 ViewName)(SD3511 41 ViewName)) Delta))
(setq DeltaP (trans (SD8446 (list Delta 0) '(0 0) (* -1.0 theAng)) 0 1))
(command "._pan" DeltaP "")
)
)
)
;***************
(defun AllLock_5202()
(if (/= (getvar "CVPORT") 1)
(command "._PSPACE")
)
(setq ObjSet nil)
(while (= ObjSet nil)
(setq ObjSet (ssget "X" '((0 . "VIEWPORT"))))
)
(setq i -1 ObjNameL nil)
(repeat (sslength ObjSet)
(setq ObjNameL (cons (ssname ObjSet (setq i (1+ i))) ObjNameL))
)
(foreach item ObjNameL
(if (/= (logand (SD3511 90 item) 16384) 16384)
(command "._VPORTS" "LOCK" "ON" item "")
)
)
)
;***************
(defun AllUnLock_5202()
(if (/= (getvar "CVPORT") 1)
(command "._PSPACE")
)
(setq ObjSet nil)
(while (= ObjSet nil)
(setq ObjSet (ssget "X" '((0 . "VIEWPORT"))))
)
(setq i -1 ObjNameL nil)
(repeat (sslength ObjSet)
(setq ObjNameL (cons (ssname ObjSet (setq i (1+ i))) ObjNameL))
)
(foreach item ObjNameL
(if (= (logand (SD3511 90 item) 16384) 16384)
(command "._VPORTS" "LOCK" "OFF" item "")
)
)
)
;***************
(defun OnlyLayout_5003()
(if (= (getvar "TILEMODE") 1)
(progn
(alert "This command is for Paper Space")
(vl-exit-with-error "")
)
)
)
;
(defun SD1028 ()
(setq OldCmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "undo" "be")
(setq OldOsmode (getvar "OSMODE"))
(setq OldLayer (getvar "CLAYER"))
(setq OldLType (getvar "CeLType"))
(setq OldCeLWeight (getvar "CeLWeight"))
(setq OldColor (getvar "CeColor"))
(setq OldOrtho (getvar "ORTHOMODE"))
(setq OldDStyle (getvar "DIMSTYLE"))
(setq OldExpert (getvar "Expert"))
(setvar "EXPERT" 0)
(princ)
)
;********************************
(defun SD2056 ()
(setvar "OSMODE" OldOsmode)
(command "undo" "end")
(setvar "CLAYER" OldLayer)
(setvar "CeLType" OldLType)
(setvar "CeLWeight" OldCeLWeight)
(setvar "CeColor" OldColor)
(setvar "ORTHOMODE" OldOrtho)
(setvar "Expert" OldExpert)
(if (and (/= (getvar "DIMSTYLE") OldDStyle)(tblsearch "DIMSTYLE" OldDStyle))
(command "-dimstyle" "Restore" OldDStyle)
)
(setvar "CMDECHO" OldCmdEcho)
(princ)
)
;**********************
(defun SD3511 (g e)
(cond
((= (type e) 'ename) (cdr (assoc g (entget e))))
((= (type e) 'list) (cdr (assoc g e)))
)
)
;;;---------Rotate----------------------------
(defun SD8446 ( PointA PointB Ang / XA YA XB YB PointC)
(setq XA2(- (car PointA) (car PointB))
YA2(- (cadr PointA) (cadr PointB))
)
(setq PointC (list (- (* XA2 (cos Ang))(* YA2 (sin Ang))) (+ (* XA2 (sin Ang))(* YA2 (cos Ang)))))
(setq PointC (mapcar '+ PointC PointB))
PointC
)
;********************************
(defun *myerror* (msg)
(setq *error* nil)
(SD2056)
(princ "\n Error Cancelled")
(princ)
)
(princ "\n Command Name: VPALH = Viewport Alignment Horizontal\n")
(princ)

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, Paper Space, Viewports. Bookmark the permalink.

Leave a comment