TheSwamp
Code Red => VB(A) => Topic started by: David Hall on June 21, 2006, 02:35:28 PM
-
I'm trying to compress my dvb files to make things simpler, and was wondering if anyone could compress this sub smaller. This sub is replacing 6-8 other subs by using the Select Case. If that doesn't make sense, I'll try and explain better.
Public Sub BATCHP(SIZE As String)
Dim currentline As String
Dim PLOTTYPE As String
Open "c:\dwgnum.dat" For Input As 1
While Not EOF(1)
Line Input #1, currentline
Documents.Open currentline
Debug.Print currentline
ThisDrawing.Regen acAllViewports
Select Case SIZE
Case "VA"
Call SetupAndPlot("11x17Draft.pc3", "STANDARDS.ctb", "Business_Letter_(8.50_x_11.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
Case "V11"
Call SetupAndPlot("11x17Draft.pc3", "11X17-CHECKSET.ctb", "ANSI_B_(11.00_x_17.00_Inches)", acScaleToFit, ac90degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
Case "VC"
Call SetupAndPlot("OCE DesignJet 750C.pc3", "VENDOR MEDIUM.ctb", "ARCH_expand_C_(24.00_x_18.00_Inches)", acScaleToFit, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
Case "VD"
Call SetupAndPlot("OCE DesignJet 750C.pc3", "VENDOR MEDIUM.ctb", "ARCH_expand_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
Case "T11"
Call SetupAndPlot("11x17Draft.pc3", "11X17-CHECKSET.ctb", "ANSI_B_(11.00_x_17.00_Inches)", acScaleToFit, ac90degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
Case "TC"
Call SetupAndPlot("OCE DesignJet 750C.pc3", "tep.ctb", "ARCH_expand_C_(24.00_x_18.00_Inches)", acScaleToFit, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
Case "TD"
Call SetupAndPlot("OCE DesignJet 750C.pc3", "tep.ctb", "ARCH_expand_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
Case Else
Call Vendor1117
End Select
Wend
Close 1
End Sub
-
here is the SetupAndPlot sub
Public Sub SetupAndPlot(ByRef Plotter As String, CTB As String, SIZE As String, PSCALE As String, ROT As String)
Dim Layout As AcadLayout
On Error GoTo Err_Control
Set Layout = ThisDrawing.ActiveLayout
Layout.RefreshPlotDeviceInfo
Layout.ConfigName = Plotter ' CALL PLOTTER
Layout.PLOTTYPE = acExtents
Layout.PlotRotation = ROT ' CALL ROTATION
Layout.StyleSheet = CTB ' CALL CTB FILE
Layout.PlotWithPlotStyles = True
Layout.CanonicalMediaName = SIZE ' CALL SIZE
Layout.PaperUnits = acInches
Layout.StandardScale = PSCALE 'CALL PSCALE
Layout.ShowPlotStyles = False
ThisDrawing.Plot.NumberOfCopies = 1
Layout.CenterPlot = True
Layout.ScaleLineweights = False
Layout.RefreshPlotDeviceInfo
ThisDrawing.Regen acAllViewports
ZoomExtents
Set Layout = Nothing
ThisDrawing.Save
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
Case "-2145320861"
MsgBox "Unable to Save Drawing- " & Err.Description
Case "-2145386493"
MsgBox "Drawing is setup for Named Plot Styles." & (Chr(13)) & (Chr(13)) & "Run CONVERTPSTYLES command", vbCritical, "Change Plot Style"
Case Else
MsgBox "Unknown Error " & Err.Number
End Select
End Sub
-
This is what i am replacing
Public Sub BATCHPLOT1824()
Dim currentline As String
Open "c:\dwgnum.dat" For Input As 1
While Not EOF(1)
Line Input #1, currentline
Documents.Open currentline
Debug.Print currentline
ThisDrawing.Regen acAllViewports
Call VendorQuickPlotC
Wend
Close 1
End Sub
Public Sub BATCHPLOT2436()
Dim currentline As String
Open "c:\dwgnum.dat" For Input As 1
While Not EOF(1)
Line Input #1, currentline
Documents.Open currentline
Debug.Print currentline
ThisDrawing.Regen acAllViewports
ThisDrawing.MSpace = False
Call VendorQuickPlotD
Wend
Close 1
End Sub
-
It looks pretty streamlined to me. You could move the plot and close to the SetupandPlot sub. Then again, you can leave them. Looks good.
-
It looks pretty streamlined to me. You could move the plot and close to the SetupandPlot sub. Then again, you can leave them. Looks good.
You sound like a weatherman.
[weatherman voice]It might rain today, then again it might not[/weatherman voice]
-
There is nothing really wrong with having seperate functions, in fact it's probably quicker as there are fewer tests (your switch statement contains many tests) where as a seperate function goes straight to the address offset of the function when called directly.
If you want to streamline your switch, put your cases in the most used order. i.e. if BATCHPLOT1824 is used most often, put it as your first switch, this way you exit your switch with lest tests more often.
To stream line your existing functions I see the same lines of code repeated in each -
(note: more as an example than a requirement for this particular code snippet)
Dim currentline As String
Open "c:\dwgnum.dat" For Input As 1
While Not EOF(1)
Line Input #1, currentline
Documents.Open currentline
Debug.Print currentline
perhaps this could be put in its own sub and reduce it to one line in each working sub, this way each sub re-uses the same code (same address in memory which saves space).
This may not be applicable in all cases but you get the idea.
This is also why almost any app needs re-writng once you've finished the first version or beta :)
hth,
Mick.
-
I don't know if this will work for you but I use goto a lot to try shorten my code.
Public Sub BATCHP(SIZE As String)
Dim currentline As String
Dim PLOTTYPE As String
Open "c:\dwgnum.dat" For Input As 1
While Not EOF(1)
Line Input #1, currentline
Documents.Open currentline
Debug.Print currentline
ThisDrawing.Regen acAllViewports
Select Case SIZE
Case "VA"
Call SetupAndPlot("11x17Draft.pc3", "STANDARDS.ctb", "Business_Letter_(8.50_x_11.00_Inches)", ac1_1, ac0degrees)
Case "V11"
Call SetupAndPlot("11x17Draft.pc3", "11X17-CHECKSET.ctb", "ANSI_B_(11.00_x_17.00_Inches)", acScaleToFit, ac90degrees)
Case "VC"
Call SetupAndPlot("OCE DesignJet 750C.pc3", "VENDOR MEDIUM.ctb", "ARCH_expand_C_(24.00_x_18.00_Inches)", acScaleToFit, ac0degrees)
Case "VD"
Call SetupAndPlot("OCE DesignJet 750C.pc3", "VENDOR MEDIUM.ctb", "ARCH_expand_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
Case "T11"
Call SetupAndPlot("11x17Draft.pc3", "11X17-CHECKSET.ctb", "ANSI_B_(11.00_x_17.00_Inches)", acScaleToFit, ac90degrees)
Case "TC"
Call SetupAndPlot("OCE DesignJet 750C.pc3", "tep.ctb", "ARCH_expand_C_(24.00_x_18.00_Inches)", acScaleToFit, ac0degrees)
Case "TD"
Call SetupAndPlot("OCE DesignJet 750C.pc3", "tep.ctb", "ARCH_expand_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
Case Else
Call Vendor1117
GoTo skip
End Select
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
skip:
Wend
Close 1
End Sub
-
Thanks Bryco, I didnt even see the last 2 lines I was repeating 8 times. That shortened it up a lot.
-
Thanks Mick! You should have seen what a mess this was before I started compressing it into re-useable pieces. Anyway, what you said made sense, so I will try and pull out the parts where I can.
-
So Mick,
what would you do with this list?Public Sub VendorA()
Call SetupAndPlot("11x17Draft.pc3", "STANDARDS.ctb", "Business_Letter_(8.50_x_11.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub Vendor1117()
Call SetupAndPlot("11x17Draft.pc3", "11X17-CHECKSET.ctb", "ANSI_B_(11.00_x_17.00_Inches)", acScaleToFit, ac90degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub VendorQuickPlotC()
Call SetupAndPlot("OCE DesignJet 750C.pc3", "VENDOR MEDIUM.ctb", "ARCH_expand_C_(24.00_x_18.00_Inches)", acScaleToFit, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub VendorQuickPlotD()
Call SetupAndPlot("OCE DesignJet 750C.pc3", "VENDOR MEDIUM.ctb", "ARCH_expand_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub TEPQuickPlot11x17()
Call SetupAndPlot("11x17Draft.pc3", "11X17-CHECKSET.ctb", "ANSI_B_(11.00_x_17.00_Inches)", acScaleToFit, ac90degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub TEPQuickPlotC()
Call SetupAndPlot("OCE DesignJet 750C.pc3", "tep.ctb", "ARCH_expand_C_(24.00_x_18.00_Inches)", acScaleToFit, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub TEPQuickPlotD()
Call SetupAndPlot("OCE DesignJet 750C.pc3", "tep.ctb", "ARCH_expand_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub TEP9800D()
Call SetupAndPlot("OCE 9800 DesignJet 750C.pc3", "tep.ctb", "ARCH_expand_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub TEPDWFD() 'Setups for C size and 11x17 do not exist, need to be created.
Call SetupAndPlot("DWF6 ePlot.pc3", "tep.ctb", "ARCH_full_bleed_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Public Sub VENDORDWFD() 'Setups for C size and 11x17 do not exist, need to be created.
Call SetupAndPlot("DWF6 ePlot.pc3", "VENDOR MEDIUM.ctb", "ARCH_full_bleed_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
since they are all self contained, would you leave as is or try and compress? All of these are in the same VBA module
-
Can you create a plot and close sub?
-
Can you create a plot and close sub?
Im not sure I understand what you asking.
A close sub would look likepublic sub DwgClose()
ThisDrawing.close true
end sub
-
I just notice that each case has
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
Can't you use a sub to make it one line?
Public Sub PlotClose()
ThisDrawing.Plot.PlotToDevice
ThisDrawing.Close (True)
End Sub
Then each case would be
Public Sub yabba()
Call dabba
PlotClose
End Sub
You save a line of code.
-
got ya! yes, that could and should be condensed. In the example Bryco posted, they moved those two lines to the bottom after the select case. In the example I just posted for Mick, those are all separate subs, so my question was should they stay separate for memory use or be combined.
-
aH...got ya...
-
got ya! yes, that could and should be condensed. In the example Bryco posted, they moved those two lines to the bottom after the select case. In the example I just posted for Mick, those are all separate subs, so my question was should they stay separate for memory use or be combined.
This can be a hard decision depending on implementation, if you are relying on random user input (i.e. they have a multiple choice like radio buttons or list box pick) a switch case with good ordering may be the only way to go but if you have buttons where the decision is 'direct', go directly to the sub without switch tests should be quicker.
As Greg said (is that THE Greg Blandin...coding!) and Bryco demonstrated you can still pick up some efficiency with some thought to 're-usable' code placement.
-
is there a way to store a variable in the dwg (im thinking user??) to specify which ctb file should be saved with that dwg. Then you could take out the random user input and go straight to the plot. I know the ctb is stored in pagesetup, but as size changes, so does the ctb file. Also, we get crap from vendors that use all kinds of colors, thus the vendor medium ctb file.
-
I'm thinking named page setups although we've had this conversation and I know you don't want to use them.
-
Bob, what I need is a way to find out whether or not a drawing was done by us or an outside vendor. That drives which ctb file to use. My biggest problem is people using the wrong ctb file. And dont even try to batch plot
-
I'm thinking named page setups...
Could that name be extracted easily in my sub? I need to test that
-
Batch plt is a great utility.It took me a while to really get it down the way I wanted. Named pagesetups are big part of it. I use it to go to plt files, then use othercomputers that do not have ACAD to print them. I am going to follow this tread closely, as automating the process from VB sounds pretty good, but I do not know where to start either. :) When I see what you guys do, it amazes me that anything I do, coding wise, works at all.
-
Could that name be extracted easily in my sub? I need to test that
Sub test()
Dim objPSet As AcadPlotConfiguration
Dim objPSets As AcadPlotConfigurations
Set objPSets = ThisDrawing.PlotConfigurations
For Each objPSet In objPSets
Debug.Print objPSet.Name
Next objPSet
End Sub
-
Here's a function that is a part of a pagesetup creation/replacement DVB that I was doing. I shelved it for some reason, maybe it was a time issue, I'm not sure, then forgot all about it until now. Maybe it will help
Function SNA11x17()
Dim objPS As AcadPlotConfiguration
Set objPS = ThisDrawing.PlotConfigurations.Add("SNA-AZTU-11x17", False)
objPS.ConfigName = "\\SERVER2\SAVIN 4035 PCL 6"
objPS.CanonicalMediaName = "Tabloid"
objPS.CenterPlot = True
objPS.PaperUnits = acInches
objPS.PlotHidden = False
objPS.PlotRotation = ac90degrees
objPS.PlotType = acExtents
objPS.PlotViewportBorders = False
objPS.PlotViewportsFirst = True
objPS.PlotWithLineweights = True
objPS.PlotWithPlotStyles = True
objPS.ScaleLineweights = False
objPS.ShowPlotStyles = False
objPS.StandardScale = acScaleToFit
objPS.StyleSheet = "SNA-11X17.ctb"
objPS.UseStandardScale = True
End Function
Now I got's to finish this thing.
-
thats a lot like mine
Public Sub SetupAndPlot(ByRef Plotter As String, CTB As String, SIZE As String, PSCALE As String, ROT As String)
Dim Layout As AcadLayout
On Error GoTo Err_Control
Set Layout = ThisDrawing.ActiveLayout
Layout.RefreshPlotDeviceInfo
Layout.ConfigName = Plotter ' CALL PLOTTER
Layout.PLOTTYPE = acExtents
Layout.PlotRotation = ROT ' CALL ROTATION
Layout.StyleSheet = CTB ' CALL CTB FILE
Layout.PlotWithPlotStyles = True
Layout.CanonicalMediaName = SIZE ' CALL SIZE
Layout.PaperUnits = acInches
Layout.StandardScale = PSCALE 'CALL PSCALE
Layout.ShowPlotStyles = False
ThisDrawing.Plot.NumberOfCopies = 1
Layout.CenterPlot = True
Layout.ScaleLineweights = False
Layout.RefreshPlotDeviceInfo
ThisDrawing.Regen acAllViewports
ZoomExtents
Set Layout = Nothing
ThisDrawing.Save
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
Case "-2145320861"
MsgBox "Unable to Save Drawing- " & Err.Description
Case "-2145386493"
MsgBox "Drawing is setup for Named Plot Styles." & (Chr(13)) & (Chr(13)) & "Run CONVERTPSTYLES command", vbCritical, "Change Plot Style"
Case Else
MsgBox "Unknown Error " & Err.Number
End Select
End Sub
-
true dat. Mine's alphabeticalized though ;P
-
I've been doing some set ups for metric and have once again failed completely to get the plotconfifs to work programmatically. It seems certain plotters wont behave. Some people have mentioned the order is important. I've switched stuff around all over the place to no avail. My code looks a lot like yours, I mean we are all setting the same things. But yours works. For a couple of years I have been using objectArx to open a template file and copy the plotconfigs which works perfectly but it's galling to not be able to do it the proper way.
Every setting is copied from a readout of a manually made plotconfig, so unless the plot origin requires umpteen decimal places they should all be kosher.
If you can see something wrong I'ld appreciate the tip.
Sub PcsMM()
Dim pC As AcadPlotConfiguration
Dim PCs As AcadPlotConfigurations
Dim oLayout As AcadLayout
Dim oLayouts As AcadLayouts
Dim PlotOrig(1) As Double
Dim Orig
Set oLayouts = ThisDrawing.Layouts
Set PCs = ThisDrawing.PlotConfigurations
Set oLayout = ThisDrawing.PaperSpace.Layout
PlotOrig(0) = 18.542: PlotOrig(1) = 12.192
Set pC = PCs.Add("22x34final", False)
With pC
.PlotType = acExtents
.CanonicalMediaName = "User1639"
.CenterPlot = True
.ConfigName = "\\DESIGNSERVER\HPDJ"
.PlotOrigin = PlotOrig
.PlotRotation = ac180degrees
.StandardScale = ac1_1
End With
PcTyp pC
oLayout.CopyFrom pC
PlotOrig(0) = 19.01: PlotOrig(1) = 12.68
Set pC = PCs.Add("22x34draft", False)
With pC
.PlotType = acLayout
.CanonicalMediaName = "User1639"
.ConfigName = "\\DESIGNSERVER\HPDRAFT"
.PaperUnits = acMillimeters
.PlotOrigin = PlotOrig
.PlotRotation = ac180degrees
.StandardScale = ac1_1
End With
PcTyp pC
oLayout.CopyFrom pC
PlotOrig(0) = 1.31: PlotOrig(1) = 4.48
Set pC = PCs.Add("11x17half", False)
With pC
.PlotType = acExtents
.CenterPlot = True
.ConfigName = "\\designserver\KONICA"
.PaperUnits = acMillimeters
.PlotOrigin = PlotOrig
.PlotRotation = ac270degrees
.StandardScale = ac1_2
'.CanonicalMediaName = "User288"
.CanonicalMediaName = "Tabloid"
End With
PcTyp pC
'ModelSpace
Set oLayout = ThisDrawing.ModelSpace.Layout
Set pC = PCs.Add("22x34-model", True)
With pC
.ConfigName = "\\DESIGNSERVER\HPDJ"
.StandardScale = ac1_1
.CanonicalMediaName = "User1639"
.PlotType = acExtents
.PlotRotation = ac180degrees
End With
PCAdds pC
Set pC = PCs.Add("22x34draft-model", True)
With pC
.ConfigName = "\\DESIGNSERVER\HPDRAFT"
.StandardScale = ac1_1
.CanonicalMediaName = "User1639"
.PlotType = acExtents
.PlotRotation = ac180degrees
End With
PcTyp pC
Set pC = PCs.Add("11x17-model", True)
Orig = ThisDrawing.GetVariable("Viewctr")
PlotOrig(0) = Orig(0): PlotOrig(1) = Orig(1)
With pC
.ConfigName = "\\designserver\KONICA"
.StandardScale = acScaleToFit
'.SetCustomScale 1, 1
.CanonicalMediaName = "Tabloid"
'.PlotType = acExtents
.CenterPlot = True
.PlotOrigin = PlotOrig
.PlotRotation = ac270degrees
End With
PcTyp pC
oLayout.CopyFrom pC
'Pc.RefreshPlotDeviceInfo
ThisDrawing.Regen 0
End Sub
Function PcTyp(pC As AcadPlotConfiguration)
With pC
.PaperUnits = acMillimeters
.PlotHidden = False
.PlotViewportBorders = False
.PlotViewportsFirst = True
.PlotWithLineweights = True
.PlotWithPlotStyles = True
.StyleSheet = "Lexington Standard.ctb"
.UseStandardScale = True
End With
End Function
I'm also not sure of the logic of using extents rather than layout. But that didn't work either.
-
Bryco, at a quick glance, I don't see anything. I'll look some more but not until Monday.
-
Bryco,
I can't help you wiith that code, but if your problem is not there, then it won't matter.
Please do not forget to do the basics to remove all other outside variables and try to narrow it down while stepping through it. If it is failing, you should see that in design time. Something "should" give you a clue.
I would try a virgin machine and remove the call to a network printer and add a dedicated one on LPT1 instead and see if that works. I would not believe the order issue. That "should" not matter.
I can do some testing for you on a couple of diffent networks if you would like. Just let me know what info you need and make a arx, dll or dvb for 2002 and I would be more than happy to test anything I can for you. I have both, a dedicated canon on its own ip and shared out plotters.
Also, I see you have hp design jet in there. I remember having many issues with those old boxes, forget what they are called, that take the cat5 cable and turn it into a parallel port. You could have a faulty cable somewhere too, stc. Best to get your coded tested other places if it really being that bad.
Good luck
You can email or call me if you want a tester.
david@smartlister dot com
<phone number removed by MP>