CADForums.net

RMW · Guest

Can someone take a look at the following code and tell me why I can't get
the plotscale to work. I want to use a block scale to set the plot scale.
I am a very novice user and any help would be greatly appreciated. Thanks

Public Sub tabloid()
Dim pt1(1) As Double
Dim Layout As AcadLayout
Dim blk As AcadBlockReference
'Dim SCX As AcPlotScale
'Dim scy As Double
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim fType(3) As Integer, fData(3)
Dim ss As AcadSelectionSet, blkRef As AcadBlockReference

Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "ss" Then
objSelSet.Delete
Exit For
End If
Next

ThisDrawing.ActiveSpace = acPaperSpace
Set Layout = ThisDrawing.PaperSpace.Layout

Set ss = ThisDrawing.SelectionSets.Add("ss")
fType(0) = 0: fData(0) = "INSERT"
fType(1) = 2: fData(1) = "ldcbordr"
ss.Select acSelectionSetAll, , , fType, fData

For Each blkRef In ss
If blkRef.XScaleFactor = 1 Then
ThisDrawing.PaperSpace.Layout.StandardScale = ac1_2 'Why doesn't this
work?
End If
Next

With ThisDrawing.PaperSpace.Layout
.RefreshPlotDeviceInfo
.PlotWithPlotStyles = True
.ConfigName = "\\ldchpsvr\hp laserjet 5100 pcl 5e"
.CanonicalMediaName = "11X17"
.PaperUnits = acInches
.PlotType = acExtents
.PlotRotation = ac90degrees
.StyleSheet = "LDC Half Scale (Black).ctb"
.CenterPlot = False
pt1(0) = -2: pt1(1) = 0
.PlotOrigin = pt1
.RefreshPlotDeviceInfo
End With
End Sub

MP · Guest

couple points of questionable value from another beginner...

Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "ss" Then
objSelSet.Delete
Exit For
End If
Next

that works but the more common method I've seen is to use an on error resume
statement with the item method

On Error Resume Next
Set objSelSet = ThisDrawing.SelectionSets.Item("ss")
If Err then 'no sel set with that name so create
Err.Clear
Set objSelSet = ThisDrawing.SelectionSets.Add("ss")
Else
objSelSet.Clear'or whatever you want to do if it already exists
End if
On Error GoTo 0'reset error handler

fType(0) = 0: fData(0) = "INSERT"
fType(1) = 2: fData(1) = "ldcbordr"
objSelSet.Select acSelectionSetAll, , , fType, fData

(since you already had objSelSet, you may not need the second ss object as
well)
also since the ubound of fType is 1
your dim could be
Dim fType(1) as integer
etc.

dim objOwner as Object(or layout or block)
then in this loop
For Each blkRef In ss
If blkRef.XScaleFactor = 1 Then
'you may want to get the ownerid to get what layout it's on
Set objOwner = ThisDrawing.ObjectIDToObject(blkRef.OwnerId).Layout
objOwner.StandardScale = ac1_2

End If
Next

eg:
Sub test()
Dim fType(1) As Integer
Dim fData(1) As Variant
Dim objSelSet As AcadSelectionSet
On Error Resume Next
Set objSelSet = ThisDrawing.SelectionSets.Item("ss")
If Err Then 'no sel set with that name so create
Err.Clear
Set objSelSet = ThisDrawing.SelectionSets.Add("ss")
Else
objSelSet.Clear 'or whatever you want to do if it already exists
End If
On Error GoTo 0 'reset error handler

fType(0) = 0: fData(0) = "INSERT"
fType(1) = 2: fData(1) = "04251_XTITLE_24X36"'change this to your block name
objSelSet.Select acSelectionSetAll, , , fType, fData
Dim objOwner As Object '(or layout or block)
'then in this loop
Dim blkRef As AcadExternalReference'change this to block ref if you're not
using xrefs
For Each blkRef In objSelSet
If blkRef.XScaleFactor = 1 Then
Set objOwner = ThisDrawing.ObjectIdToObject(blkRef.OwnerID).Layout
Debug.Print objOwner.Name
objOwner.StandardScale = ac1_2
MsgBox "Now scale is " & objOwner.StandardScale
End If
Next

End Sub

hth
Mark

"RMW" <nospam@nospam.com> wrote in message news:41d9739a_2@newsprd01...

VBA · Guest

I believe you need to set the plotscale in an appropriate PlotConfig.

"RMW" <nospam@nospam.com> wrote in message news:41d9739a_2@newsprd01...

	CADForums.net Forum Index -> VBA	All times are GMT
Page 1 of 1