Help with coding VBA..

[basepointdesignz]

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..

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

....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..

 

[TCARPENTER]

Hi Paul,

Try this:

FType(0) = 8: FData(0) = "VP-PLOT"
FType(1) = 0: FData(1) = "[b][red]LW[/red][/b]Polyline"

HTH
Todd

 

[basepointdesignz]

Hi, Thanks Todd, that seemed to do it, so now i have line through the diagonals of the printable area, so now at least know the code is working so far, except for one area:

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

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..

 

[TCARPENTER]

Hi Paul,

Take a look at FAQ687-5792, 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

 

[basepointdesignz]

Hi,

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:

' Display number of schedules to plot..
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:

Private Sub cmdPLOT_Click()
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..

 

[TCARPENTER]

Hi Paul,

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:

MinWin(0) = MinExt(0)
MinWin(1) = MinExt(1)
MaxWin(0) = MaxExt(0)
MaxWin(1) = MaxExt(1)
...

Then just use MinWin with SetWindoToPlot.

HTH
Todd

 

[basepointdesignz]

Hi,

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:

Private Sub cmdPLOT_Click()

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..

 

[TCARPENTER]

Hi Paul,

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...

Public Sub ApplySettings()
  '
  ' ***** 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