Help with coding VBA..
Help with coding VBA..
(OP)
Hi,
I'm trying to write a program that will plot all modelspace part schedules for certain projects. Basically around each A4 schedule page i have drawn a polyline on the VP-PLOT layer, which acts as the boundary to window-plot the schedule..
What I want the program to do is search for all of those polylines on that layer and use the bounding box of the polyline as the window coordinates for a window-plot..
There will be 2 option of how to capture the required schedules. One button for ALL SCHEDULES, basically selecting the entire drawing, and the cmdWINDOW_Click is for a user window selection. But for now i only have the window select button working. Well i say working, but this is why i am posting the code here - its not doing what it's supposed to do, so could anyone help me out, point me in the right direction, correct my code.
So far, i have coded it so that to see if the code is working, it draws lines from corner-to-corner of the required print areas. Once this is working, i'll chuck in the code to plot..
As all it's getting is as far as picking the selection window and then returning back to the form, but as far as drawing the line across the area which is going to print nothing happens..
....as i said before, if anyone could point out my mistakes and / or correct me or just point me in the right direction, i would be very thankful..
I'm trying to write a program that will plot all modelspace part schedules for certain projects. Basically around each A4 schedule page i have drawn a polyline on the VP-PLOT layer, which acts as the boundary to window-plot the schedule..
What I want the program to do is search for all of those polylines on that layer and use the bounding box of the polyline as the window coordinates for a window-plot..
There will be 2 option of how to capture the required schedules. One button for ALL SCHEDULES, basically selecting the entire drawing, and the cmdWINDOW_Click is for a user window selection. But for now i only have the window select button working. Well i say working, but this is why i am posting the code here - its not doing what it's supposed to do, so could anyone help me out, point me in the right direction, correct my code.
So far, i have coded it so that to see if the code is working, it draws lines from corner-to-corner of the required print areas. Once this is working, i'll chuck in the code to plot..
As all it's getting is as far as picking the selection window and then returning back to the form, but as far as drawing the line across the area which is going to print nothing happens..
CODE
Option Explicit
Dim baseX As Variant 'First point for window selection..
Dim baseY As Variant 'Second point for window selection..
Dim entityX As AcadEntity 'Acad Objects..
Dim selectset As AcadSelectionSet 'Selection set..
Dim FType(0 To 1) As Integer 'Filter type..
Dim FData(0 To 1) As Variant 'Filter data..
Dim MinExt As Variant 'Min (bottom-left) point for each rectangle..
Dim MaxExt As Variant 'Max (top-right) point for each rectangle..
Dim linex As AcadLine
Dim i As Integer 'Count..
Private Sub cmdPLOT_Click()
' Awaiting code..
End Sub
' GET SELECTION SET BY WINDOW..
Private Sub cmdWINDOW_Click()
plotflashform.HIDE
'GET FIRST CORNER OF THE BORDER RECTANGLE..
'Error Test for GetPoint method..
On Error Resume Next
TryAgain:
baseX = ThisDrawing.Utility.GetPoint(, "Pick the first corner of the window..")
ErrHndlr:
If Err.Number <> 0 Then
Err.Clear
GoTo TryAgain
End If
On Error GoTo ErrHndlr
'GET SECOND CORNER OF THE BORDER RECTANGLE..
' Error Test for GetCorner method..
On Error Resume Next
TryAgain2:
baseY = ThisDrawing.Utility.GetCorner(baseX, "Pick the second corner of the window..")
ErrHndlr2:
If Err.Number <> 0 Then
Err.Clear
GoTo TryAgain2
End If
On Error GoTo ErrHndlr2
Err.Clear 'Clear the Error log..
'GET SELECTION SET..
Set selectset = ThisDrawing.SelectionSets.Add("Schedules")
'SET FILTER DATA..
FType(0) = 8: FData(0) = "VP-PLOT"
FType(1) = 0: FData(1) = "Polyline"
' Build selection set..
selectset.Select acSelectionSetWindow, baseX, baseY, FType, FData
'Draw a line through each print-frame just as a test to see if the code works for now..
For Each entityX In selectset
entityX.GetBoundingBox MinExt, MaxExt
Set linex = ThisDrawing.ModelSpace.AddLine(MinExt, MaxExt)
Next
' Display number of schedules to plot..
lbl1.Caption = "Number of Schedules to Plot: " & selectset.Count
' Show the user form for more options..
plotflashform.Show
End Sub
'
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' Delete all selection sets in drawing..
For Each selectset In ThisDrawing.SelectionSets
selectset.Delete
Next
End Sub
Dim baseX As Variant 'First point for window selection..
Dim baseY As Variant 'Second point for window selection..
Dim entityX As AcadEntity 'Acad Objects..
Dim selectset As AcadSelectionSet 'Selection set..
Dim FType(0 To 1) As Integer 'Filter type..
Dim FData(0 To 1) As Variant 'Filter data..
Dim MinExt As Variant 'Min (bottom-left) point for each rectangle..
Dim MaxExt As Variant 'Max (top-right) point for each rectangle..
Dim linex As AcadLine
Dim i As Integer 'Count..
Private Sub cmdPLOT_Click()
' Awaiting code..
End Sub
' GET SELECTION SET BY WINDOW..
Private Sub cmdWINDOW_Click()
plotflashform.HIDE
'GET FIRST CORNER OF THE BORDER RECTANGLE..
'Error Test for GetPoint method..
On Error Resume Next
TryAgain:
baseX = ThisDrawing.Utility.GetPoint(, "Pick the first corner of the window..")
ErrHndlr:
If Err.Number <> 0 Then
Err.Clear
GoTo TryAgain
End If
On Error GoTo ErrHndlr
'GET SECOND CORNER OF THE BORDER RECTANGLE..
' Error Test for GetCorner method..
On Error Resume Next
TryAgain2:
baseY = ThisDrawing.Utility.GetCorner(baseX, "Pick the second corner of the window..")
ErrHndlr2:
If Err.Number <> 0 Then
Err.Clear
GoTo TryAgain2
End If
On Error GoTo ErrHndlr2
Err.Clear 'Clear the Error log..
'GET SELECTION SET..
Set selectset = ThisDrawing.SelectionSets.Add("Schedules")
'SET FILTER DATA..
FType(0) = 8: FData(0) = "VP-PLOT"
FType(1) = 0: FData(1) = "Polyline"
' Build selection set..
selectset.Select acSelectionSetWindow, baseX, baseY, FType, FData
'Draw a line through each print-frame just as a test to see if the code works for now..
For Each entityX In selectset
entityX.GetBoundingBox MinExt, MaxExt
Set linex = ThisDrawing.ModelSpace.AddLine(MinExt, MaxExt)
Next
' Display number of schedules to plot..
lbl1.Caption = "Number of Schedules to Plot: " & selectset.Count
' Show the user form for more options..
plotflashform.Show
End Sub
'
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' Delete all selection sets in drawing..
For Each selectset In ThisDrawing.SelectionSets
selectset.Delete
Next
End Sub
....as i said before, if anyone could point out my mistakes and / or correct me or just point me in the right direction, i would be very thankful..
Cheers,
Paul
basepointdesignzltd..
P4 3.0Ghz / 2GB RAM
XP Pro SP2
Sapphire X1950 512MB Dual-DVi Graphics Card..
Talk To Other Members
RE: Help with coding VBA..
Try this:
CODE
FType(1) = 0: FData(1) = "LWPolyline"
HTH
Todd
RE: Help with coding VBA..
CODE
' Delete all selection sets in drawing..
For Each selectset In ThisDrawing.SelectionSets
selectset.Delete
Next
End Sub
It keeps flagging up an automation error on this bit of code. All i want to do is to erase all selection sets in the drawing so that when / if the program is run again, the named SS can be created again without errors. Is what i have, the best way to do this or have i simply got it in the worng place? Bearing in mind that when i had it as the first code in the routine, it still flagged up errors..
Cheers,
Paul
basepointdesignzltd..
P4 3.0Ghz / 2GB RAM
XP Pro SP2
Sapphire X1950 512MB Dual-DVi Graphics Card..
RE: Help with coding VBA..
Take a look at FAQ687-5792: Easier selection set creation in VB/VBA., that should explain it. I prefer the method in the FAQ simply because you never really know at what point in your routine the code could blow-up, so checking prior to making a selection is a much safer way to go.
HTH
Todd
RE: Help with coding VBA..
Right got myself a little bit further in this and am stuck so far on two bits:
Firstly, getting the selection set count to appear on the userform. I bet its simple but its not displaying anything. See code below:
CODE
lbl1.Caption = "Number of Schedules to Plot: " & selectset.Count
.......next is the plotting itself. Now this is ModelSpace printing and i can't find much on the net about it to help..
Here is the code:
CODE
For Each entityX In selectset
ThisDrawing.ModelSpace.Layout.PlotType = acWindow
ThisDrawing.ModelSpace.Layout.SetWindowToPlot MinExt, MaxExt
ThisDrawing.ActiveLayout.UseStandardScale = True
ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
ThisDrawing.ModelSpace.Layout.PlotOrigin = MinExt
ThisDrawing.ModelSpace.Layout.PlotRotation = ac0degrees
ThisDrawing.Plot.PlotToDevice
Next
End Sub
the ThisDrawing.ModelSpace.Layout.SetWindowToPlot MinExt, MaxExt flags up an error saying 'Incorrect number of elements in SafeArray. MinExt and MaxExt are variants and they are the bounding box points of the found polyline plot areas..
Any ideas on whats up with both my probs, and could someone point me in the direction of vba plotting, especially modelspace plotting..
Cheers,
Paul
basepointdesignzltd..
P4 3.0Ghz / 2GB RAM
XP Pro SP2
Sapphire X1950 512MB Dual-DVi Graphics Card..
RE: Help with coding VBA..
First problem, try repainting the form after setting the caption.
Second, SetWindowToPlot wants only X,Y whereas the bounding box returns X,Y,Z. You just need something like:
CODE
MinWin(1) = MinExt(1)
MaxWin(0) = MaxExt(0)
MaxWin(1) = MaxExt(1)
...
Then just use MinWin with SetWindoToPlot.
HTH
Todd
RE: Help with coding VBA..
Still having problems with the plotting aspect. It always calls a runtime 5 error 'Invalid Procedure or Argument' on each line of the plot code (mainly on the setwindowtoplot line of code:
CODE
Dim MinWin(0 To 1), MaxWin(0 To 1) As Double 'Plot points..
For Each entityX In selectset
entityX.GetBoundingBox MinExt, MaxExt
MinWin(0) = MinExt(0): MinWin(1) = MinExt(1)
MaxWin(0) = MaxExt(0): MaxWin(1) = MaxExt(1)
ThisDrawing.ModelSpace.Layout.PlotType = acWindow
ThisDrawing.ModelSpace.Layout.SetWindowToPlot MinWin, MaxWin
ThisDrawing.ActiveLayout.UseStandardScale = True
ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
'ThisDrawing.ModelSpace.Layout.PlotOrigin = MinWin
ThisDrawing.ModelSpace.Layout.PlotRotation = ac0degrees
ThisDrawing.Plot.PlotToDevice
Next
End Sub
Any ideas? Or any ideas of where to get help with VBA plotting, i can't find much at all on the net..
Cheers,
Paul
basepointdesignzltd..
P4 3.0Ghz / 2GB RAM
XP Pro SP2
Sapphire X1950 512MB Dual-DVi Graphics Card..
RE: Help with coding VBA..
Been a while since I've worked with the plot/layout object but here's a chunk of what I did several years ago - it seems to me the order of how things were set was important. See if you can adapt this to work for you...
CODE
'
' ***** ApplySettings *****
'
' Assign all the needed plot settings based on our record database and
' plot settings dialog box.
'
With AcadDoc
With .ActiveLayout
.ConfigName = rstFiles("PlotDevice").Value
.StyleSheet = rstFiles("PlotStyleTable").Value
.PaperUnits = rstFiles("PaperUnits").Value
.CanonicalMediaName = rstFiles("MediaName").Value
.PlotType = rstFiles("PlotType").Value
.PlotRotation = rstFiles("PlotRotation").Value
.PlotOrigin = rstFiles("PlotOrigin").Value
.CenterPlot = rstFiles("CenterPlot").Value
.UseStandardScale = rstFiles("UseStandardScale").Value
.StandardScale = rstFiles("Scale").Value
.ScaleLineweights = rstFiles("ScaleLineweights").Value
.PlotWithLineweights = rstFiles("PlotWithLineweights").Value
.PlotWithPlotStyles = rstFiles("PlotWithPlotStyles").Value
.PlotViewportsFirst = rstFiles("PlotPSpaceLast").Value
.PlotHidden = rstFiles("PlotHidden").Value
End With
With .Plot
.NumberOfCopies = intNumberOfCopies
.QuietErrorMode = True
End With
End With
End Sub
HTH
Todd