TheSwamp
Code Red => VB(A) => Topic started by: havano on November 03, 2006, 11:40:29 AM
-
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!
-
ThisDrawing.Layouts.Add "LayoutName"
ThisDrawing.PaperSpace.AddPViewport Center, Width, Height
psltscale = 1
-
That should get you started. Hope it helps
-
Would that be all? So that's why no-one bothers to mention it elsewhere... thanks!
OK, meanwhile I have got started:
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.
-
This should get you started
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
-
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?
-
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.
-
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.
-
havano I would rather help you put some code that you have started,
-
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 (http://www.geocities.com/havano.holland/) with the "graphic details".
-
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?
-
Here's something that should get you there.
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
-
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:
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.
-
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!
-
I'm glad you are putting it all together Havano, it sounds like quite an ambitious project.