create viewport from rectangle or block

[angelinabrown0123]

Hi All

I want to make viewport from rectangle or block, have to keep the scale of viewport 0.5, I don't know if it is possible with VBA code. If it is possible with VBA code then help me to provide the code.

Thank in advance

[grobnik]

@norman.yuan thank you very much for your support and patience later i'll prepare a sample dwg to share.

Bye

[angelinabrown0123]

@norman.yuan 

After checking the coordinates, I realized that they didn't match, so the objects in the viewport couldn't adjust the zoom correctly, after thinking for a while I found out that the base point of my block is in the middle center.

[grobnik]

@norman.yuan 

Hi Norman, sorry to boring you, but looking at your procedure there is a point with following code

Private Sub CreatePVort(border As BorderBlock)

Dim vport As AcadPViewport
Dim center(0 To 2) As Double
center(0) = 200: center(1) = 150: center(2) = 0

Please could you help me explaining the above value ? they are coming from ?

Is there the possibility to fix the vport insertion in a wanted insertion point coordinates ?

I'm still fighting with vport position on layout compared with full window title block.

Thank you

[norman.yuan]

@grobnik ,

I assume you have read my article, where explained that I just choose that point (200, 150) as assumed layout center. As you know, the focus of this discussion is to determine the viewport's size, twist angle and zoom the modelspace content properly. Once the viewport size is determined, you could place it on anywhere of a layout. Then you can manually move it as you want. And if the layout's paper size is too big or to small, you obviously need to adjust the layout's paper type/size (e.g. AcadPlotConfiguration). If you want to programmatically place the viewport in the center of a layout with PROPER paper size, then you need to first examine the target layout's paper size and possibly need to use your code to configure the layout to a suitable paper size, then you get get the layout's center where you can drop the viewport. Again, I just omitted all these steps for simplicity, because it is kind of beyond the topic discussion, thus the assumed layout center of (200, 150), which is the the approximate center of the layout paper size that fits the viewport my code generated.

[grobnik]

@norman.yuan 

Thank you very much for your time and explanation, I'll make some experiment.

Thank you again.

Bye

[MakCADD · Accepted solution]

It is not much perfect as an application

here i used send command to modify viewport

Sub ConvertBlks_To_Vport()

Dim Vp As AcadPViewport
Dim BlkrM As AcadBlockReference 'Block in Model
Dim BlkrVp As AcadBlockReference 'Same Block in Paper: scale 1
Dim iNSPT(0 To 2) As Double         ' 0,0,0

'Select Blocks from the Modelspace
Dim BlkSel As AcadSelectionSet
Dim SelType(0) As Integer, SelName(0) As Variant
On Error Resume Next
Set BlkSel = ThisDrawing.SelectionSets.Add("Blks")
    If Err.Description <> "" Then
    Debug.Print Err.Description
    Err.Clear
    Set BlkSel = ThisDrawing.SelectionSets("Blks")
    BlkSel.Clear
    End If
On Error GoTo 0
SelType(0) = 2
SelName(0) = InputBox("Select Blocks:", "Select Blocks")
ThisDrawing.ActiveSpace = acModelSpace
BlkSel.SelectOnScreen SelType, SelName

'Loop through each Block in Model
For b = 0 To BlkSel.Count - 1
Set BlkrM = BlkSel(b)

ThisDrawing.ActiveSpace = acPaperSpace
'Insert block in Paperspace with scale 1
Set BlkrVp = ThisDrawing.PaperSpace.InsertBlock(iNSPT, BlkrM.Name, 1, 1, 1, 0)
BlkrVp.GetBoundingBox Point1, Point2

'Vport properties
Dim CenPt(0 To 2) As Double
CenPt(0) = (Point1(0) + Point2(0)) * 0.5
CenPt(1) = (Point1(1) + Point2(1)) * 0.5
CenPt(2) = (Point1(2) + Point2(2)) * 0.5
vpheight = Point2(1) - Point1(1)
vpwidth = Point2(0) - Point1(0)

Set Vp = ThisDrawing.PaperSpace.AddPViewport(CenPt, 1, 1) 'Modify size later
Vp.Display True

'Using sendcommand to modify viewport
vpHandle = "(handent " & Chr(34) & Vp.Handle & Chr(34) & ")"
ThisDrawing.SendCommand "rotate" & vbCr & vpHandle & vbCr & vbCr & CenPt(0) & "," & CenPt(1) & vbCr & 0 - (BlkrM.Rotation * (45 / Atn(1))) & vbCr
ThisDrawing.SendCommand "vpclip" & vbCr & vpHandle & vbCr & "delete" & vbCr

'Update vp size
Vp.Height = vpheight
Vp.Width = vpwidth


'Find the center in Modelspace and zoom center
ThisDrawing.MSpace = True
BlkrM.GetBoundingBox Point1, Point2
Dim ZCent(0 To 2) As Double
    For i = 0 To 2
    ZCent(i) = (Point1(i) + Point2(i)) * 0.5
    Next i
ZoomCenter ZCent, 1
'Update VpScale according to the block in Model
Vp.CustomScale = 1 / BlkrM.XScaleFactor

BlkrVp.Delete 'Not needed
 
ThisDrawing.MSpace = False

iNSPT(1) = iNSPT(1) - vpheight

Next b

BlkSel.Delete 'Selection set deleted

End Sub

[angelinabrown0123]

@MakCADD 

Very nice this is really amazing it creates the viewport from multiple blocks it will save me a lot of time,

Thank you very much.

[aammarJHHNU]

Thank your for this amazing code.

I want just to add a new UCS for every Pviewport orientation, can you help me ?

Thanks

[MakCADD]

you can draw a line at the location and set the ucs to object