Link to http://www.autocadtips.wordpress.com

This routine compliments the previous routine quite nicely. But this time it aligns viewports vertically.

The same tip that I mentioned in the previous tip applies here as well. If you need to cycle through to another viewport, use CTRL + R to cycle through viewports…

Here’s how:

• VPALV <enter> to start (ViewPort ALign Vertically)
• Specify the base point that the other viewport will be aligned to
• Click inside another viewport to activate that viewport
• Specify a base point in this viewport to be aligned (vertically) with 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 by Greg battin and featured @ www.autocadtips.wordpress.com
; modified for english only use and removed registry stuff
(defun c:VPALV ( / Pt1 VP1 VP2 Pt1P ok Pt2 Pt2P Delta DeltaM ObjSet ObjNameL OpSwitch
Delta theAng ViewName)
(setq OpSwitch 2)
(SD_5202)
)
;***************
(defun SD_5202 ( / )
(princ "\n Viewport Alignment Vertically")
(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 Layout Tab")
(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: VPALV = Vertical Viewport Alignment\n")
(princ)