Не конкретно ответ на твой вопрос но многое
даст понять
Public Sub AlignViewPorts()
' By Said Abbassi Nov. 2006
' This is my first successful program (as I think), I publish it as a gift to all the world designers
' Please email comments or suggestions to abbassisaid@yahoo.fr
' This routine aligns the views in 2 or 3 paper view ports
' by selecting a source point in a paper view port,
' and a target points to be aligned with, horizontally or vertically or both in other paper view ports
Dim oMyPViewPort As AcadPViewport
Dim bOldStatePVP As Boolean
Dim vPntTargetMH As Variant
Dim vPntTargetPH As Variant
Dim vPntTargetMV As Variant
Dim vPntTargetPV As Variant
Dim vPntToMoveM As Variant
Dim vPntToMoveP As Variant
Dim vPntNewM As Variant
Dim vPntNewP(0 To 2) As Double
Dim vViewCtr As Variant
If ThisDrawing.ActiveSpace acPaperSpace Then
ThisDrawing.Utility.Prompt vbCrLf & "This command requires the paper space to be on, please active a layout and try again." & vbCr
Exit Sub
ElseIf ThisDrawing.MSpace = False Then
ThisDrawing.Utility.Prompt vbCrLf & "This command requires an active view port, please have one active and try again." & vbCr
Exit Sub
End If
On Error GoTo 1
'Input for horizontal or vertical alignment
Dim sKeyWord As String
Dim sResp As String
sKeyWord = "Vertical Horizontal Both"
ThisDrawing.Utility.InitializeUserInput 2 + 4 + 8 + 16 + 32 + 64, sKeyWord
sResp = ThisDrawing.Utility.GetKeyword(vbCrLf & "Select alignement type: Vertical, Horizontal, :")
If sResp = "" Then sResp = "Both"
' Selection of a point in the 1st view port to be aligned (Moved)
vPntToMoveM = ThisDrawing.Utility.GetPoint(, vbCrLf & "Select the point to be aligned (Moved):")
Set oMyPViewPort = ThisDrawing.ActivePViewport
bOldStatePVP = oMyPViewPort.DisplayLocked
oMyPViewPort.DisplayLocked = False
' Translate it into paper space
vPntToMoveP = ThisDrawing.Utility.TranslateCoordinates(vPntToMoveM, acDisplayDCS, acPaperSpaceDCS, False)
' Selection of a horizontal target point
If sResp = "Horizontal" Or sResp = "Both" Then
vPntTargetMH = ThisDrawing.Utility.GetPoint(, vbCrLf & "Activate the horizontal view port and select a target point:")
' Translate it into paper space
vPntTargetPH = ThisDrawing.Utility.TranslateCoordinates(vPntTargetMH, acDisplayDCS, acPaperSpaceDCS, False)
End If
' Selection of a vertical target point
If sResp = "Vertical" Or sResp = "Both" Then
vPntTargetMV = ThisDrawing.Utility.GetPoint(, vbCrLf & "Activate the vertical view port and select a target point:")
' Translate it into paper space
vPntTargetPV = ThisDrawing.Utility.TranslateCoordinates(vPntTargetMV, acDisplayDCS, acPaperSpaceDCS, False)
End If
' Horizontal alignment
If sResp = "Horizontal" Or sResp = "Both" Then
vPntNewP(0) = vPntToMoveP(0)
vPntNewP(1) = vPntTargetPH(1)
vPntNewP(2) = vPntToMoveP(2) ' for clarity only
End If
' Vertical alignment
If sResp = "Vertical" Or sResp = "Both" Then
vPntNewP(0) = vPntTargetPV(0)
If sResp = "Vertical" Then vPntNewP(1) = vPntToMoveP(1)
vPntNewP(2) = vPntToMoveP(2) ' for clarity only
End If
' Activate the source view port
ThisDrawing.ActivePViewport = oMyPViewPort
' Translate the new point vPntNewP into MS
vPntNewM = ThisDrawing.Utility.TranslateCoordinates(vPntNewP, acPaperSpaceDCS, acDisplayDCS, False)
' Get the center view
vViewCtr = ThisDrawing.GetVariable("VIEWCTR")
If sResp = "Vertical" Or sResp = "Both" Then vViewCtr(0) = vViewCtr(0) + (vPntToMoveM(0) - vPntNewM(0))
If sResp = "Horizontal" Or sResp = "Both" Then vViewCtr(1) = vViewCtr(1) + (vPntToMoveM(1) - vPntNewM(1))
ZoomCenter vViewCtr, ThisDrawing.GetVariable("VIEWSIZE")
oMyPViewPort.DisplayLocked = bOldStatePVP
Exit Sub
1: ThisDrawing.Utility.Prompt "Error: Program ended." & vbCrLf
End Sub~'J'~
