Topic: How to add/change layout tabs and properties. Any tutorial?

[havano]

Does anyone know of an online step-by-step VBA tutorial on how to create a paperspace layout tab, a layout template, a viewport and a geometry selection from modelspace within this viewport, and also on how to get the linetype scaling there identical to that in modelspace? By now I know my way in modelspace-related programming, but paperspace still provides me with many mysteries/miseries.

Any (constructive) suggestion would be more then welcome!

[David Hall]

ThisDrawing.Layouts.Add "LayoutName"
ThisDrawing.PaperSpace.AddPViewport Center, Width, Height
psltscale = 1

[David Hall]

That should get you started.  Hope it helps

[havano]

Would that be all? So that's why no-one bothers to mention it elsewhere... thanks!

OK, meanwhile I have got started:

Code: [Select]

Public Sub AddMyLayout()
On Error Resume Next 'convenient at least while testing
'add the layout
ThisDrawing.Layouts.Add "MyLayout"
'remove the default tabs
ThisDrawing.Layouts.Item("Layout1").Delete
ThisDrawing.Layouts.Item("Layout2").Delete
On Error GoTo 0
Now, I want to populate MyLayout with geometry from a 3rd party drawing, stored as C:\MyAppPath\StdSheets.DWG. This drawing has several layout tabs. One of them, "A4Portrait",  contains a block reference for a drawing sheet, named "A4Psheet", one for the titleblock textstrings, named "A4Ptext" and a viewport intended for showing (part of) modelspace's geometry.

• How do I make these A4 layout elements show up in MyLayout?
• How can I make the predefined viewport show the desired modelspace area without changing its shape and relative position in MyLayout?

My efforts sofar have failed. Please point me in the right direction.

[Bryco]

This should get you started

Code: [Select]

Public Function CopyDwgLayout(sPath As String, SourceName, TargetName As String) As AcadLayout

    Dim axDoc As AxDbDocument
    Dim Doc As AcadDocument
    Dim sLayout As AcadLayout
    Dim tLayout As AcadLayout
    Dim i As Integer
    Dim objArray() As Object
   
    Set Doc = ThisDrawing
    Set axDoc = New AxDbDocument
    axDoc.Open sPath
    Set sLayout = axDoc.Layouts(SourceName)
    Set tLayout = Doc.Layouts.Add(TargetName)
    If sLayout.Block.count > 0 Then
        ReDim objArray(0 To sLayout.Block.count - 1)
        For i = 0 To sLayout.Block.count - 1
            Set objArray(i) = sLayout.Block.Item(i)
        Next
        axDoc.CopyObjects objArray, tLayout.Block
    End If
    tLayout.CopyFrom sLayout 'here you copy the pagesetups etc
    Set axDoc = Nothing


End Function

Sub TestCopyLayout()
Dim sPath As String
sPath = "C:\MyAppPath\StdSheets.DWG"
CopyDwgLayout sPath, "A4Psheet", "A4Psheet"
End Sub

[havano]

Thanks Bryco, but no luck here. Your line "Dim axDoc As AxDbDocument" returns "Compile error, user-defined type not defined". Documentation on AxDbDocument seems nonexistent. I use Autocad 2007, might that be (part of) the problem?

[Bryco]

Look in Tools-> references  and in the pull down list add a reference to objectdbx ,  mine looks like->
Autocad/Objectdbx Common 16.0 type library
yours probably has a 17 in it.

[havano]

It works! Thanks Bryco.
Now I can proceed to determine how to manipulate the imported blockref's attributes, make the now existing viewport show a specific area of modelspace etc. Any pointers on that would also be appreciated.

[Bryco]

havano I would rather help you put some code that you have started,

[havano]

Actually, the code-in-the-making is an independent subroutine that will be called at the end of a huge interactive parametric-drawing macro, just before the final drawing is saved. It should add 4 layout-tabs to the drawing (using your code hereabove) and change the viewport properties of each of them, in order to display specific areas of model space (depending on the generated geometry). Also, it should fill out the block attributes of each layout-titleblock.

I could provide you with some sample drawings. This weekend, I will put up a temporary website with the "graphic details".

[Bryco]

Havano, I can't open those drawings, I only have 2006.
The attributes, there is plenty of info on this site about attribute handling.
The viewport view; are you selecting the scale and objects to be viewed by the extents of the 2 layers?

[Bryco]

Here's something that should get you there.

Code: [Select]

Public Sub AlignMsToVp()

    Dim Vp As AcadPViewport
    Dim VpsCol As New Collection
    Dim Ent As AcadEntity
    Dim oBref As AcadBlockReference
    Dim M1, M2, P1, P2, CenPt(2) As Double
    Dim Mdist As Double, PDist As Double
 
    ThisDrawing.ActiveSpace = acPaperSpace
    'Get the viewport
    For Each Ent In ThisDrawing.PaperSpace
        If TypeOf Ent Is AcadPViewport Then
            VpsCol.Add Ent
        End If
    Next
    'The first Vp is the layout itself
    If VpsCol.count < 2 Then Exit Sub
    If VpsCol(2).ObjectID > VpsCol(1).ObjectID Then
        Set Vp = VpsCol(2)
    Else
        Set Vp = VpsCol(1)
    End If
   
    If ThisDrawing.MSpace = False Then
        Vp.Display True
        ThisDrawing.MSpace = True
    End If
    'Define your modelspace area
    'Here you need a blockref called "MyLayoutArea"
    'That is a rectangle on defpoints
    Dim Ss As AcadSelectionSet
    Set Ss = sset(2, "MyLayoutArea")
    Ss(0).GetBoundingBox M1, M2
    Vp.GetBoundingBox P1, P2
    Mdist = M2(0) - M1(0)
    PDist = P2(0) - P1(0)
    ThisDrawing.MSpace = True
    CenPt(0) = (M2(0) + M1(0)) / 2: CenPt(1) = (M2(1) + M1(1)) / 2
   
    Vp.StandardScale = acVpCustomScale
    'This is how it is done, set the ZoomCenter
    ThisDrawing.Application.ZoomCenter CenPt, 1
    Vp.CustomScale = PDist / Mdist
    ThisDrawing.MSpace = False

End Sub

[havano]

That IS fast, Bryco! When do you sleep?
Meanwhile, the ZIPped drawing files on the website have been replaced with Acad2004 type files.

Selecting the objects to be shown in the viewport: something like this:

Code: [Select]

Dim algobj As AcadEntity
Dim LowX As Long, HighX As Long
Dim LowY As Long, HighY As Long
Dim BBoxMin, BBoxMax
LowX = 2147483647: HighX = -2147483647
LowY = 2147483647: HighY = -2147483647

For Each algobj In ThisDrawing.ModelSpace
    If algobj.Layer = "Plattegrond" Or algobj.Layer = "ISO-projectie" Then
        algobj.GetBoundingBox BBoxMin, BBoxMax
        If BBoxMin(0) < LowX Then LowX = BBoxMin(0)
        If BBoxMax(0) > HighX Then HighX = BBoxMax(0)
        If BBoxMin(1) < LowY Then LowY = BBoxMin(1)
        If BBoxMax(1) > HighY Then HighY = BBoxMax(1)
    End If
Next

This yields the XY coördinates of the common bounding box. But I see you are doing something similar in your code . I will try your solution tomorrow.

[havano]

OK Bryco, you helped me solve my main problem, and I found solutions to some of the peripheral problems elsewhere. Now I think I can piece it all together.
Thanks again!

[Bryco]

I'm glad you are putting it all together Havano, it sounds like quite an ambitious project.