The current problem appears to be the statement:
ThisDrawing.ActivePViewport = objPViewPort which I've indicated with a
comment in the code below. It causes a runtime error. It's not just my
code either, when I copy the code FROM THE HELP TEXT that shows an example
of setting the active PViewPort, it causes the SAME ERROR -> Run-time error
'-2145320877 (80210053)'. Mysteriously, when I copied some code that was
posted from RDH at AutoDesk that used the ActivePViewport, it worked and I
can't for the life of me tell why.
Why won't this work? Better yet, WHY WON'T THE HELP TEXT WORK?????
Dim objPaperSpaceEntity As AcadEntity
Dim objViewPortEntity As AcadEntity
Dim objPViewPort As AcadPViewport
Dim ssetViewPort As AcadSelectionSet
Dim dblLowerLeft(2) As Double
Dim dblUpperRight(2) As Double
Dim dblPDCS(2) As Double
For Each objPaperSpaceEntity In ThisDrawing.PaperSpace
If TypeOf objPaperSpaceEntity Is AcadPViewport Then
lngViewPortEntities = 0
Set objPViewPort = objPaperSpaceEntity
'Make the viewport active.
objPViewPort.Display True
ThisDrawing.MSpace = True
ThisDrawing.ActivePViewport = objPViewPort '**This line causes
the error.**
'Use the viewport width and height to find the distance from the
center of the viewport.
dblPDCS(0) = objPViewPort.width / 2
dblPDCS(1) = objPViewPort.height / 2
'Translate the distance from center from paperspace display
coordinate system to display coordinate system.
vntDCS = ThisDrawing.Utility.TranslateCoordinates(dblPDCS,
acPaperSpaceDCS, acDisplayDCS, True)
'Translate the distance from center from display coordinate
system to world coordinate system.
vntWCS = ThisDrawing.Utility.TranslateCoordinates(vntDCS,
acDisplayDCS, acWorld, True)
'Form the lower left and upper right corners of the viewport
dblLowerLeft(0) = objPViewPort.Center(0) - vntWCS(0)
dblLowerLeft(1) = objPViewPort.Center(1) - vntWCS(1)
dblUpperRight(0) = objPViewPort.Center(0) + vntWCS(0)
dblUpperRight(1) = objPViewPort.Center(1) + vntWCS(1)
'Create a selection set containing only entities that lie within
the coordinates of viewport.
Set ssetViewPort = ThisDrawing.SelectionSets.Add("SSET")
ssetViewPort.Select acSelectionSetWindow, dblLowerLeft,
dblUpperRight
For Each objViewPortEntity In ssetViewPort
.
.
.
.
Next objViewPortEntity
End If
Next objPaperSpaceEntity
Set ThisDrawing.ActivePViewport = objPViewPort
Object doesn't support this property or method (Error 438)
Thanks for the effort though.
Mark Holder wrote in message <378A51FE...@atscorporation.com>...
It seems that the first PViewport returned from a Layout/PaperSpace
collection is not a real PViewport but an object similar to the Model Space
current Viewport. The PViewport count is always one more than the visible
PViewport.
Trying to set this pseudo PViewport as the ActivePViewport seems to be the
source of your problem.
Would you try this modification:
Dim colPVp As New Collection
ThisDrawing.ActiveSpace = acPaperSpace
For Each objPaperSpaceEntity In ThisDrawing.PaperSpace
If TypeOf objPaperSpaceEntity Is AcadPViewport Then
colPVp.Add objPaperSpaceEntity
End If
Next objPaperSpaceEntity
For counter = 2 To colPVp.Count
lngViewPortEntities = 0
Set objPViewPort = colPVp(counter)
'Make the viewport active.
objPViewPort.Display acOn
ThisDrawing.Application.ActiveDocument.MSpace = True
ThisDrawing.MSpace = acOn
ThisDrawing.ActivePViewport = objPViewPort
....
Next counter
Denis
Dwayne Parkinson a écrit dans le message
<7mdgq6$67...@adesknews2.autodesk.com>...
I looked at the online help for ActivePViewPort, and it, like your code, omits
the "SET" from the property statement "ThisDrawing.ActivePViewport =
objPViewPort". How is this possible? Does it really work like that, or is it a
typeo?
Mark Holder
Here how the ActivePViewport property would have been implemented if it has
been written in vb:
Private mActivePViewport As AcadPViewPort
Public Property Get ActivePViewport() As AcadPViewPort
'Note that the Set instruction already returns
'a reference to mActivePViewport
'This explains why you you don't need to use it
' in the client part
Set ActivePViewport = mActivePViewport
End Property
Hope this helps you understand what happens under the scene.
Denis
This replaces my previous mail which was not complete.
A similar ActivePViewport property could be implemented in a vb class module
using the following code:
Private mActivePViewport As AcadPViewPort
Public Property Get ActivePViewport() As AcadPViewPort
Set ActivePViewport = mActivePViewport
End Property
Public Property Set ActivePViewport(PVPort As Object)
Set mActivePViewport = PVPort
End Property
As you can see in the property Set procedure, the Set instruction has to be
located in the server application in order to reference the private
mActivePViewport object to the object passed from the client side which
actually is objPViewPort.
The following statements would therefore have the same effect:
ThisDrawing.ActivePViewport = objPViewPort
Set mActivePViewport = objPViewPort
Hope this helps you understand even if it is not a conform representation of
what's happening under the scene.
Denis
Here's the real issue though... I need to get a selection set that selects
the items within each viewport on the drawing. I can read through the
viewports on a drawing and get the associated center, width, height, etc.
Richard Howard from Autodesk provided some code on how to translate
coordinates from paperspace coordinates on the viewports to something that's
supposed to work with a selection set. The problem appears to be that the
viewport must be active for the code to work and I can't activate it. If
there's some better way to translate coordinates, the whole issue of
activating a viewport goes away.
Now, about your code. Is there some significance to why you used "acOn"
instead of "True" when you made the viewport active? Also, why did you have
the line: ThisDrawing.Application.ActiveDocument.MSpace=True?
As for the code listed below, I was already keeping track of which viewport
I was processing with a variable called intViewPortCount, so I just set it
to negative one to start out and then conditioned the rest of the code so
that the count had to be greater than zero which should effectively skip the
first PViewPort in the collection and accurately count the number of
viewports encountered. As I said earlier, I did try it exactly as you
described, but I still couldn't get past the error. After developing a flat
spot on my forehead from whacking it into the desk for a week, I've decided
to pay Autodesk for help, BUT they don't have any answers yet, so if anybody
comes up with a solution I'll be ecstatic.
****************************************************************************
****
intViewPortCount = -1
'Read through the paper space objects and process those that are viewports.
For Each objPaperSpaceEntity In ThisDrawing.PaperSpace
If TypeOf objPaperSpaceEntity Is AcadPViewport Then
'The first PViewport returned is not a true paperspace viewport,
so skip it.
intViewPortCount = intViewPortCount + 1
If intViewPortCount > 0 Then
lngViewPortEntities = 0
Set objPViewPort = objPaperSpaceEntity
MsgBox "Width=" & Str(objPViewPort.width) & " Height=" &
Str(objPViewPort.height)
'Make the viewport active.
objPViewPort.Display True
ThisDrawing.MSpace = True
ThisDrawing.ActivePViewport = objPViewPort
'Use the viewport width and height to find the distance from
the center of the viewport.
dblPCS(0) = objPViewPort.width / 2
dblPCS(1) = objPViewPort.height / 2
'Translate the distance from center from paperspace display
coordinate system to display coordinate system.
vntDCS = ThisDrawing.Utility.TranslateCoordinates(dblPCS,
acPaperSpaceDCS, acDisplayDCS, True)
'Translate the distance from center from display coordinate
system to world coordinate system.
vntWCS = ThisDrawing.Utility.TranslateCoordinates(vntDCS,
acDisplayDCS, acWorld, True)
'Form the lower left and upper right corners of the viewport
dblLowerLeft(0) = objPViewPort.Center(0) - vntWCS(0)
dblLowerLeft(1) = objPViewPort.Center(1) - vntWCS(1)
dblUpperRight(0) = objPViewPort.Center(0) + vntWCS(0)
dblUpperRight(1) = objPViewPort.Center(1) + vntWCS(1)
'Create a selection set containing only entities that lie
within the coordinates of viewport.
Set ssetViewPort = ThisDrawing.SelectionSets.Add("SSET")
ssetViewPort.Select acSelectionSetCrossing, dblLowerLeft,
dblUpperRight
'ssetViewPort.Select acSelectionSetAll
'Read through every entity in the selection set and store
data in arrays to process later.
For Each objViewPortEntity In ssetViewPort
...
Next objViewPortEntity
ssetViewPort.Delete
End If 'If intViewPortCount > 0
End If 'If TypeOf objPaperSpaceEntity Is AcadPViewport
Next objPaperSpaceEntity
****************************************************************************
****
Denis Gagné wrote in message <7mdut7$6u...@adesknews2.autodesk.com>...
Richard Howard really had a great idea and I don't think you'll find better.
I made minor corrections to the code you sent (except that you forgot to
transform your PViewport center from PaperspaceDCS to World coordinates) and
it works just fine returning all the entities within each PViewport of the
active PaperSpace Layout. I'll certainly keep this for further use.
I can't explain why your PaperSpace collection returns more than one false
PViewport object and was unable to reproduce this situation. If you
elucidate the question, I can help you for the rest.
Denis
Well, here it is. The answer to all my problems. I feel obligated to post
this because it's so very neat and so many people have helped me. MANY MANY
thanks to Jeremy and Richard at AutoCAD.
The high level description....
1) Get into paperspace
2) Get the viewports paperspace width and height.
3) Calculate a ratio of width to height.
4) Get the XData for the viewport.
5) The XData contains modelspace coordinates for height (item 7) and center
coordinates (items 8 & 9) so retrieve those values.
6) Apply the ratio from step 3 to the height from step 5 to get the width
of the viewport relative to modelspace.
7) Calculate the lower left coordinate by taking the center-width/2 and
center-height/2.
8) Calculate the upper right coordinate by taking the center+width/2 and
center+height/2.
9) Change to modelspace.
10) Create the selection set using the coordinates from step 7 and 8.
... Voila ...
Instant selection set containing items within a viewport and you didn't even
have to translate any coordinates... very cool.
----------------------------------------------------------------------------
--------
For Each objPaperSpaceEntity In ThisDrawing.PaperSpace
If TypeOf objPaperSpaceEntity Is AcadPViewport Then
'The first PViewport returned is not a true paperspace viewport,
so skip it.
intViewPortCount = intViewPortCount + 1
If intViewPortCount > 0 Then
lngViewPortEntities = 0
Set objPViewPort = objPaperSpaceEntity
'Convert from the viewport paperspace coordinates, to model
space coordinates that can be used in a selection set.
'Calculate the ratio of height to width on the viewport in
paperspace.
lngViewPortRatio = objPViewPort.height / objPViewPort.width
'Get the viewports extended data (XData) which contains its
center and height in modelspace.
objPViewPort.GetXData "ACAD", vntXTypeOut, vntXDataOut
lngViewPortHeight = vntXDataOut(7)
lngViewPortCenter(0) = vntXDataOut(8)
lngViewPortCenter(1) = vntXDataOut(9)
'Use the model space height and the ratio of height to width
to arrive at the viewport width in model space.
lngViewPortWidth = lngViewPortHeight * lngViewPortRatio
'Form the lower left and upper right corners of the
selection set in model space.
dblLowerLeft(0) = lngViewPortCenter(0) - (lngViewPortWidth /
2)
dblLowerLeft(1) = lngViewPortCenter(1) - (lngViewPortHeight
/ 2)
dblUpperRight(0) = lngViewPortCenter(0) + (lngViewPortWidth
/ 2)
dblUpperRight(1) = lngViewPortCenter(1) + (lngViewPortHeight
/ 2)
'Create a selection set containing only entities that lie
within the coordinates of viewport.
ThisDrawing.ActiveSpace = acModelSpace
Set ssetViewPort = ThisDrawing.SelectionSets.Add("SSET")
ssetViewPort.Select acSelectionSetCrossing, dblLowerLeft,
dblUpperRight
'Read through every entity in the selection set and store
data in arrays to process later.
For Each objViewPortEntity In ssetViewPort
....
Next objViewPortEntity
ssetViewPort.Delete
End If 'If intViewPortCount > 0
End If 'If TypeOf objPaperSpaceEntity Is AcadPViewport
ThisDrawing.ActiveSpace = acPaperSpace
Next objPaperSpaceEntity
HI Dwayne,
I'm glad you've found a solution that you're happy with.
I am curious though, without the cs translations it would
seem that you could only work with WCS coplaner viewpoints.
On second thought, not just coplaner, but ortho-normal will
be required as well. Have I overlooked something obvious,
or is this issue not a problem for you?
rdh.
Very kind of you to share informations you paid for.
Using XData in this situation seems much appropriate but I prefered your
original idea of building a selection set without switching to ModelSpace
which is very annoying when you have multiple PViewports.
Other comments:
1) In your code, you assume that the correspondant PViewport window will be
included in the current view activated when you switch to ModelSpace. This
is not always true and you may have to do a ZoomWindow, ZoomCenter or
whatever...
Note that if the SelectionSetCrossing defined window is not in your active
view, chances are that the select method will return no entity at all.
2) For a different reason, some entities may be absent of your sset.
Replacing the corresponding line whith this one may help you to calculate a
window of the right size.
lngViewPortWidth = lngViewPortHeight / lngViewPortRatio
Hope that these comments will help you to remain happy and satisfied. If not
just ignore them.
Mes salutations,
Denis
Hmmm... It seems even worse than I originally
thought. I'm not sure how the technique you've
posted could work *at all* Dwayne.
I must be missing something fundamental - like
maybe an alternate AutoCAD universe. <g>
Try creating some entities that are more than
about a dozen units away from the origin, and
I think you'll begin to see it fail. There is some
fundamental flaw with this technique. Where did
you say you got it?
The coplaner issue seems real even if you can
fix whatever this current flaw is. I can only suggest
you revisit my proposed technique, which I know
works.
Good luck-
rdh.
The "solution" I got from AutoCAD support appears to have worked only for
the first few drawings I tested either by coincidence, circumstance or as
some grand cosmic scheme designed to toy with my caffine laden mind. So it
appears Richard may be right when he says there's a fundamental flaw with
that method. Anyway, after reading what everyone wrote and having the code
fail for a bunch of drawings I called back AutoCAD support. They'll be
looking into it.
In the mean time I've decided to give the RDH conversion method another try
because of everyone's comments and also because an attachment on the last
e-mail I got from the support people included an example that is very close
to Richard's code which leads me to believe that his method is indeed the
"right" way to do this.
As you suggested, the RDH conversion method does work for the active
viewport if you convert the center point. I didn't convert the center
before because it wasn't done in the sample (see "Mysteriously empty
selection set" ) and I'm very new to AutoCAD and VBA so I just assumed that
for whatever reason it didn't need to be converted. Ooops :)
So the problem continues to be iterating through the viewports and making
them active. In the sample from AutoCAD support, they use
ThisDrawing.SetVariable "CVPORT", 2 to activate a viewport and it results in
a Run-time error -2145320858 (80210066). In my code I used
ThisDrawing.ActivePViewport = objPViewPort results which produced a Run-time
error -2145320877 (80210053). Unfortunately this puts me right back to
where I started on 6/30. Why is setting the active viewport not working?
The code that Richard posted where viewports are added and then the last one
is made active does indeed work (see Activating A PViewPort from 7/9), but I
can't seem to make an EXISTING viewport active. Someone indicated that the
first viewport is something other than a true viewport which is why
intViewPortCount is checked in my function, (earlier on it is set to -1 so
when I check for 0 I am indeed getting the second viewport). Is there
something going on with my if statement that's checking for viewports? Is
it not checking for the right type of viewport and I'm running into object
compatibility issues? You (Denis) said that "it" worked when you tested
"it." Does that "it" include looping through more than one existing
viewport and if so, how did you do that? Also, for the AutoCAD solution,
you mentioned that I may have to use ZoomWindow or ZoomCenter, why? Will I
have to do that for the RDH method too?
Thanks very much for any answers you may provide. As usual, I've included
the latest version of my extract data function for your reference.
Dwayne
P.S. This sure puts the FUN in FUNction doesn't it.
========================
For Each objPaperSpaceEntity In ThisDrawing.PaperSpace
If TypeOf objPaperSpaceEntity Is AcadPViewport Then
'Try checking for a viewport another way
'If objPaperSpaceEntity.ObjectName = "AcDbViewport" Then
'The first PViewport returned is not a true paperspace viewport,
so skip it.
intViewPortCount = intViewPortCount + 1
If intViewPortCount > 0 Then
lngViewPortEntities = 0
Set objPViewPort = objPaperSpaceEntity
'**************************************************
'Translate width and height from paper to display and
finally world coordinates.
objPViewPort.Display True
ThisDrawing.MSpace = True
ThisDrawing.ActivePViewport = objPViewPort 'Produces an
error
dblPDCS(0) = objPViewPort.width / 2
dblPDCS(1) = objPViewPort.height / 2
vntDCS = ThisDrawing.Utility.TranslateCoordinates(dblPDCS,
acPaperSpaceDCS, acDisplayDCS, True)
vntWCSWidthHeight =
ThisDrawing.Utility.TranslateCoordinates(vntDCS, acDisplayDCS, acWorld,
True)
'Translate center to world coordinates.
Set objPViewPort = ThisDrawing.ActivePViewport
dblPDCS(0) = objPViewPort.Center(0)
dblPDCS(1) = objPViewPort.Center(1)
vntDCS = ThisDrawing.Utility.TranslateCoordinates(dblPDCS,
acPaperSpaceDCS, acDisplayDCS, True)
vntWCSCenter =
ThisDrawing.Utility.TranslateCoordinates(vntDCS, acDisplayDCS, acWorld,
True)
'Set the lower left and upper right coordinates.
dblLowerLeft(0) = vntWCSCenter(0) - vntWCSWidthHeight(0)
dblLowerLeft(1) = vntWCSCenter(1) - vntWCSWidthHeight(1)
dblUpperRight(0) = vntWCSCenter(0) + vntWCSWidthHeight(0)
dblUpperRight(1) = vntWCSCenter(1) + vntWCSWidthHeight(1)
'***********************************************
'Commented out AutoCAD solution
'Convert from the viewport paperspace coordinates, to model
space coordinates that can be used in a selection set.
'Calculate the ratio of height to width on the viewport in
paperspace.
'lngViewPortRatio = objPViewPort.height / objPViewPort.width
'Get the viewports extended data (XData) which contains its
center and height in modelspace.
'objPViewPort.GetXData "ACAD", vntXTypeOut, vntXDataOut
'lngViewPortHeight = vntXDataOut(7)
'lngViewPortCenter(0) = vntXDataOut(8)
'lngViewPortCenter(1) = vntXDataOut(9)
'Use the model space height and the ratio of height to width
to arrive at the viewport width in model space.
'lngViewPortWidth = lngViewPortHeight * lngViewPortRatio
'Form the lower left and upper right corners of the
selection set in model space.
'dblLowerLeft(0) = lngViewPortCenter(0) - (lngViewPortWidth
/ 2)
'dblLowerLeft(1) = lngViewPortCenter(1) - (lngViewPortHeight
/ 2)
'dblUpperRight(0) = lngViewPortCenter(0) + (lngViewPortWidth
/ 2)
'dblUpperRight(1) = lngViewPortCenter(1) +
(lngViewPortHeight / 2)
'Create a selection set containing only entities that lie
within the coordinates of viewport.
'ThisDrawing.ActiveSpace = acModelSpace
'*************************************************************
MsgBox Str(dblLowerLeft(0)) & " " & Str(dblLowerLeft(1)) &
" - " & Str(dblUpperRight(0)) & " " & Str(dblUpperRight(1))
Set ssetViewPort = ThisDrawing.SelectionSets.Add("SSET")
ssetViewPort.Select acSelectionSetCrossing, dblLowerLeft,
dblUpperRight
'Read through every entity in the selection set and store
data in arrays to process later.
For Each objViewPortEntity In ssetViewPort
...
Next objViewPortEntity
ssetViewPort.Delete
End If 'If intViewPortCount > 0
End If 'If TypeOf objPaperSpaceEntity Is AcadPViewport
'ThisDrawing.ActiveSpace = acPaperSpace
Next objPaperSpaceEntity
Hi Dwayne,
This seems to have turned into quite an ordeal - but
I think your persistence will pay off. You have all the
pieces already - it's just a matter of using them.
I don't need your code - I need your requirements.
Can you state succinctly what your goal is again?
Is it: get an array of object references representing
all visible entities in all paperspace viewports from
some specific layout?
rdh.
In General: Get an array of object references representing certain eligible
entities within a viewport for EACH viewport on the drawing.
Specifically:
The process...
1. Our drawings have two types of information I need to deal with: items
and products. Both are blocks.
2. A logical relationship exists between the items and products and it must
be maintained.
3. Our engineers create viewports that encompass "groups" of related items
and products to establish that relationship.
4. More than one group can exist on a drawing.
5. Groups ARE NOT related to each other and MUST be processed seperately.
My task... Within each group (viewport) on a drawing, take each item and
combine its information with every product in the group to create a record
containing a combination of item and product information.
Here's my really sad orchard analogy. On your orchard drawing you draw an
apple tree with the trunk and the branches. Then below that tree you draw
an apple leaf and indicate (in block attributes) that you'll need ten
thousand of those. Then you draw an apple blossom and indicate that you'll
need 500 of those and finally you draw the apple and indicate that you'll
need 400 of those. Now on the same orchard drawing you put a pear tree
trunk with branches and a pear leaf with a quantity of nine thousand and
finally a pear with a quantity of 450. The program has to create data like
AppleTree,Leaf,10000
AppleTree,AppleBlossom,500
AppleTree,Apple,400
PearTree,Leaf,9000
PearTree,Pear,450
It shouldn't ever come up with this:
PearTree,Apple,400
To maintain this relationship we're using viewports as the mechanism for
grouping related items which is why I need to read through the viewports and
process data "contained" within their boundaries.
Hope this helps and as always, thanks very much for your help.
Dwayne
Dwayne,
Give the following a try...
I've used arrays here as you requested, but if it were
mine I'd probably choose collection classes instead.
If I read your requirements correctly, I think I've got your
'grouping' logic right. But if not, it shouldn't be difficult
to adapt it.
You didn't say how you'd like to output the groupings,
so I've just dumped the hierarchy to the debug window.
Do whatever it is you need there instead.
Not to dissuade you from your current practices, but
you may also want to consider a more standard way
of grouping in the future - perhaps using events and
AutoCAD groups to segregate the items for each product.
''''
'''' demo for Dwayne Parkinson
''' rdh - 990715
''''
''''
Option Explicit
''' define item structure - name, count
Private Type ItemStruct
name As String
Count As Long
End Type
''' define product structure - name, items array
Private Type ProductStruct
name As String
Items() As ItemStruct
End Type
''' declare product array
Private Products() As ProductStruct
'''
''' get product offset in array
'''
Private Function GetProduct(productname As String) As Long
Dim i As Long
'' initialize negative return
GetProduct = -1
'' iterate products
For i = LBound(Products) To UBound(Products)
'' find name
If productname = Products(i).name Then
GetProduct = i
Exit For
End If
Next i
End Function
'''
''' add product to array
'''
Private Sub AddProduct(productname As String)
Dim i As Long
'' if it's the first product
If "" = Products(0).name Then
'' set first product name
Products(0).name = productname
'' initialize new items array
ReDim Products(0).Items(0)
Else
'' get the product
i = GetProduct(productname)
'' if product not found, add it
If -1 = i Then
'' get the new upper bound
i = UBound(Products) + 1
'' resize array to accommodate
ReDim Preserve Products(i)
'' set new product name
Products(i).name = productname
'' initialize new items array
ReDim Products(i).Items(0)
End If
End If
End Sub
'''
''' get item offset in array
'''
Private Function GetItem(i As Long, itemname As String) As Long
Dim j As Long
'' initialize negative return
GetItem = -1
'' iterate products
For j = LBound(Products(i).Items) To UBound(Products(i).Items)
'' find name
If itemname = Products(i).Items(j).name Then
GetItem = j
Exit For
End If
Next j
End Function
'''
''' add item to array
'''
Private Sub AddItem(productname As String, itemname As String)
Dim i As Long
Dim j As Long
Dim k As Long
'' get the product
i = GetProduct(productname)
'' if we got a product
If -1 <> i Then
'' if it's the first item
If "" = Products(i).Items(0).name Then
'' set first item name and count
Products(i).Items(0).name = itemname
Products(i).Items(0).Count = 1
Else
'' get the item
j = GetItem(i, itemname)
'' if we got the item
If -1 <> j Then
'' increment the item count
k = Products(i).Items(j).Count
Products(i).Items(j).Count = k + 1
'' else add an item
Else
'' get the new upper bound
j = UBound(Products(i).Items) + 1
'' resize array to accommodate
ReDim Preserve Products(i).Items(j)
'' set new item name and count
Products(i).Items(j).name = itemname
Products(i).Items(j).Count = 1
End If
End If
End If
End Sub
'''
''' dump products, items, and quantities to debug window
'''
Private Sub Dump()
Dim i As Long
Dim j As Long
Debug.Print "Quantities"
Debug.Print "=========="
'' iterate products
For i = LBound(Products) To UBound(Products)
'' print product name
Debug.Print Products(i).name
'' iterate product:items
For j = LBound(Products(i).Items) To UBound(Products(i).Items)
'' print items and quantity
Debug.Print " " & Products(i).Items(j).name & _
": " & Products(i).Items(j).Count
Next j
Next i
End Sub
'''
''' apparent pixel size in drawing units
''' assumes square pixels
'''
Function PixelSize() As Double
Dim viewsize As Double
Dim screensize As Variant
viewsize = ThisDrawing.GetVariable("viewsize")
screensize = ThisDrawing.GetVariable("screensize")
PixelSize = viewsize / screensize(1)
End Function
'''
''' viewcorners
''' output lower left and the upper right corners
''' of the currently active viewport in the DCS
'''
Sub ViewCorners(ll As Variant, ur As Variant)
Dim screensize As Variant
Dim vcd As Variant
Dim vcu As Variant
Dim pix As Double
Dim sx As Double
Dim sy As Double
With ThisDrawing
'' get screen size in pixels
screensize = .GetVariable("screensize")
'' project viewcenter to dcs
vcu = .GetVariable("viewctr")
vcd = .Utility.TranslateCoordinates(vcu, acUCS, acDisplayDCS, False)
End With
'' get apparent pixel size
pix = PixelSize
'' calculate screen size in drawing units
sx = (pix * screensize(0)) / 2
sy = (pix * screensize(1)) / 2
'' set ll corner
ReDim ll(2)
ll(0) = vcd(0) - sx: ll(1) = vcd(1) - sy: ll(2) = 0
'' set ur corner
ReDim ur(2)
ur(0) = vcd(0) + sx: ur(1) = vcd(1) + sy: ur(2) = 0
End Sub
'''
''' select all entities within a specified paperspace viewport
''' caller must delete the selection set before calling again
'''
Private Function SelectInPview(Pview As AcadPViewport) As AcadSelectionSet
Dim ss As AcadSelectionSet
Dim pTmp(2) As Double
Dim ll As Variant
Dim ur As Variant
Dim dll As Variant
Dim dur As Variant
'' activate the pview...
'' ...first we need to display it (same as mview on)...
Pview.Display True
'' ...next we need to go to modelspace...
ThisDrawing.MSpace = True
'' ...then we set it active
ThisDrawing.ActivePViewport = Pview
Dim viewsize As Double
Dim ratio As Double
'' get the current paperspace viewport
Set Pview = ThisDrawing.ActivePViewport
'' use utility
With ThisDrawing.Utility
ViewCorners dll, dur
pTmp(0) = dll(0): pTmp(1) = dll(1)
ll = .TranslateCoordinates(pTmp, acDisplayDCS, acWorld, False)
pTmp(0) = dur(0): pTmp(1) = dur(1)
ur = .TranslateCoordinates(pTmp, acDisplayDCS, acWorld, False)
End With
'' add a selection set
Set ss = ThisDrawing.SelectionSets.Add("ss")
'' select crossing window
ss.Select acSelectionSetWindow, ll, ur
'' highlight the ents
ss.Highlight True
'' return selection
Set SelectInPview = ss
End Function
'''
''' product:item counter
''' all your product:item relationship logic goes here
'''
Private Sub Quantify(ss As AcadSelectionSet)
Dim ent As AcadEntity
Dim bref As AcadBlockReference
Dim attribref As Variant
Dim productname As String
Dim itemname As String
'' first, find product - should only be one
For Each ent In ss
'' if it's a blockref
If ent.ObjectName = "AcDbBlockReference" Then
'' cast to specific type
Set bref = ent
'' interate the attributerefs
For Each attribref In bref.GetAttributes
'' check if it's the product
If "PRODUCT" = attribref.TagString Then
'' get the productname
productname = attribref.TextString
'' add product to products array
AddProduct productname
'' now move on to items
Exit For
End If
Next attribref
If "" <> productname Then
Exit For
End If
End If
Next ent
'' if we found a product
If "" <> productname Then
'' find items - will be many names and counts
For Each ent In ss
'' if it's a blockref
If ent.ObjectName = "AcDbBlockReference" Then
'' cast to specific type
Set bref = ent
'' interate the attributerefs
For Each attribref In bref.GetAttributes
'' check if it's an item
If "ITEM" = attribref.TagString Then
'' get the itemname
itemname = attribref.TextString
'' add the item to product
AddItem productname, itemname
End If
Next attribref
End If
Next ent
End If
End Sub
'''
''' manual test
'''
Sub test()
Dim ss As AcadSelectionSet
ReDim Products(0)
Set ss = ThisDrawing.SelectionSets.Add("test2")
ss.SelectOnScreen
Quantify ss
ss.Delete
Dump
End Sub
'''
''' main function
'''
Public Sub Main()
On Error Resume Next
Dim ent As AcadEntity
Dim Pview As AcadPViewport
Dim Layout As AcadLayout
Dim ss As AcadSelectionSet
Dim sInput As String
ReDim Products(0)
'' use drawing
With ThisDrawing
'' get a layout name
sInput = InputBox("Enter a layout to quantify", "Quantify")
'' get the layout
Set Layout = .Layouts(sInput)
If Layout Is Nothing Then
MsgBox "Layout not found: " & sInput
Exit Sub
End If
'' make the layout active
.ActiveLayout = Layout
'' iterate paperspace
For Each ent In .PaperSpace
'' if it's a pview
If ent.ObjectName = "AcDbViewport" Then
'' cast to specific type
Set Pview = ent
Set ss = SelectInPview(Pview)
If 0 = Err Then
Quantify ss
End If
ss.Delete
End If
Err.Clear
Next ent
Dump
End With
End Sub
Cheers-
rdh.
Finally we get to the foundamental question.
and curiously the question is not from Dwayne.
Richard you were not the only one to ignore the requirements:
1) the requirements for a PViewport to be activated
- ex.: **it has to be in the layout's current View**
- ex.: **the first enumerated PViewport of a
ppSpace collection cannot be activated**
- and others I may ignore
2) the requirements for a crossing sset to return all the entities
within a defined window
- a window definition and a Viewport are related one to other
like apples in a tree, comme le seau et son puit,
comme la louche et son chaudron...
Sometimes I'm wondering if this NG main activity is not to find the unknown
requirements?
What I can say is that Richard Howard definitely pointed the easiest
solution. It works in any situation even on isometric views (R14 or R2000
drawings). Dwayne, you may ***redefine a new Viewport in modelspace just for
a sset operation*** but this is complicated and the viewport you need is
available in PaperSpace.
There are still those unanswered questions: Why can't you activate the
second PViewport? What is different in your drawings?
Sorry, but for these I can't help you.
Denis
Let me try to make this PERFECTLY clear. First, forget the "requirements"
as I fear that all they've done is cloud the real issue. While it's
probably nice for you all to know what the program is supposed to do, the
fact is that the program works. IT WORKS, it does EXACTLY what it's
supposed to do with the exception of being able to iterate through the
viewports. If you scroll all the way back to the beginning of this mess (or
even back to my original message on 6/30) you'll see that the real
FUNDAMENTAL QUESTION has been and still is...
WHY CAN'T I ACTIVATE VIEWPORTS?
Somehow I've got to find out WHY the sample code in the help text, Richard's
latest program, my program, the sample from AutoCAD support and the program
Denis e-mailed me ALL (that's right, ALL) fail when they operate on these
drawings.
I'm posting one of the drawings out in the autocad.customer-files. The
subject is Active PViewport - Sample Drawing. With the posting is code that
Denis e-mailed which he said worked for him. It promptly failed when I ran
it against the drawing that I posted. If anyone has any luck with this I'd
sure like to hear about it.
Dwayne
The stupid locked viewports have been causing the run-time error. Maybe
it's just me, but that seems like it would've been a handy piece of
information to include in the help text.
I have no problem using the code I showed last night
on your sample drawing. The quantify logic doesn't
find anything useful of course, but I have no problem
iterating, activating, or selecting from the viewports.
I'm not sure what else to suggest - but I am certain
the code I supplied works.
rdh.
1) the requirements for a PViewport to be activated
- ex.: **it has to be in the layout's current View**
One line was missing for this to happen:
'Make the viewport active.
ThisDrawing.ActiveSpace = acPaperSpace
ThisDrawing.MSpace = False 'Missing line
ThisDrawing.Application.ZoomExtents
......
Tested with the drawing you sent. OK
My curiosity is satisfied
Your days' counter is stopped at 11.
Denis
Dwayne Parkinson a écrit dans le message
<7mno22$jt...@adesknews2.autodesk.com>...
That's odd. Locked pviews should not have inhibited
the code I've demonstrated in any way. Since I don't
alter the view characteristics it's unclear why locking
has any effect at all. What exception is thrown?
rdh.
Are you sure that PViewports that are not shown on the
Current View (Screen) will also be enumerated?
Denis
I see your point...
At least some portion of the pview must be visible to
activate it. Worse still, because we are using a crossing
window selection, the entire pview must be visible to
yield a meaningful selection.
So, you're right. A zoom extents in paperspace before
processing seems to be a prudent step.
rdh.
I believe it works! Of course I've believed that before haven't I? There
were several little problems with the code. Between both of your examples I
was able figure out what my code was missing and get something that appears
to be working. The ZoomExtents Denis suggested was the last little bit
required to make it "work." I hesitate to ask, but do you think there's
anything ELSE? I ran this against ten drawings with anywhere from one to
eight viewports and it appears to have grabbed the information correctly.
Dwayne
******************************************************
intViewPortCount = -1
'Read through the paper space objects and process those that are
viewports.
For Each objPaperSpaceEntity In ThisDrawing.PaperSpace
If TypeOf objPaperSpaceEntity Is AcadPViewport Then
'The first PViewport returned is not a true paperspace
viewport, so skip it.
intViewPortCount = intViewPortCount + 1
If intViewPortCount > 0 Then
lngViewPortEntities = 0
Set objPViewPort = objPaperSpaceEntity
'Make the viewport active.
ThisDrawing.ActiveSpace = acPaperSpace
ThisDrawing.Application.ZoomExtents
objPViewPort.Display True
ThisDrawing.MSpace = True
ThisDrawing.ActivePViewport = objPViewPort
'Use the viewport width and height to find the distance
from the center of the viewport.
dblPCS(0) = objPViewPort.width / 2
dblPCS(1) = objPViewPort.height / 2
dblPCS(2) = 0#
vntPCS = dblPCS
'Translate the distance from center from paperspace
display coordinate system to display coordinate system.
vntDCS =
ThisDrawing.Utility.TranslateCoordinates(vntPCS, acPaperSpaceDCS,
acDisplayDCS, True)
'Translate the distance from center from display
coordinate system to world coordinate system.
vntWCS =
ThisDrawing.Utility.TranslateCoordinates(vntDCS, acDisplayDCS, acWorld,
True)
'Translate the center coordinates from paperspace
display coordinate system to display coordinate system.
vntCenter = objPViewPort.Center
vntDCS =
ThisDrawing.Utility.TranslateCoordinates(vntCenter, acPaperSpaceDCS,
acDisplayDCS, False)
'Translate center coordinates from display coordinate
system to world coordinate system.
vntCenter =
ThisDrawing.Utility.TranslateCoordinates(vntDCS, acDisplayDCS, acWorld,
False)
'Form the lower left and upper right corners of the
viewport
dblLowerLeft(0) = vntCenter(0) - vntWCS(0)
dblLowerLeft(1) = vntCenter(1) - vntWCS(1)
dblUpperRight(0) = vntCenter(0) + vntWCS(0)
dblUpperRight(1) = vntCenter(1) + vntWCS(1)
'Create a selection set containing only entities that
lie within the coordinates of viewport.
Set ssetViewPort = ThisDrawing.SelectionSets.Add("SSET")
ssetViewPort.Select acSelectionSetCrossing,
dblLowerLeft, dblUpperRight
'Read through every entity in the selection set and
store data in arrays to process later.
For Each objViewPortEntity In ssetViewPort
.....
You've made it to the swampy everglades by my
reconing. <g>
Your code does work for a somewhat limited, but
still useful subset of views.
While it did allow for view rotations, my original
implementation was only applicable to affine view
transformations.
After looking at your drawing I can see that you only
use wcs coplaner viewpoints, which the old technique
is suitable for. But as a general technique, I will say
that it is limited.
In last nights installment I went back to square one
and re-thought the whole thing. The new implementation
handles *any* view transformation, including non-affine
projections like perspective. My new method will work
anytime an entity can be seen in the viewport, and window
selection is allowed. That's nearly always.
I've pulled everything into the following test code, so that
you (and others following along) can compare the results.
Run TestSelectInPview, select a pview, and choose the
old or new implementation. Depending on the nature
of the view, the old one may not highlight correctly.
''''
'''' Select entities in paperspace viewport comparison
'''' 990716 - rdh
''''
Option Explicit
With ThisDrawing
'''
''' new technique
''' handles any view, even non-affine
'''
Private Function SelectInPview(Pview As AcadPViewport) As AcadSelectionSet
Dim ss As AcadSelectionSet
Dim pTmp(2) As Double
Dim ll As Variant
Dim ur As Variant
Dim dll As Variant
Dim dur As Variant
'' activate the pview...
'' ...first we need to display it (same as mview on)...
Pview.Display True
'' ...next we need to go to modelspace...
ThisDrawing.MSpace = True
'' ...then we set it active
ThisDrawing.ActivePViewport = Pview
Dim viewsize As Double
Dim ratio As Double
'' get the current paperspace viewport
Set Pview = ThisDrawing.ActivePViewport
'' use utility
With ThisDrawing.Utility
'' get the view corners in dcs
ViewCorners dll, dur
'' translate corners to wcs
pTmp(0) = dll(0): pTmp(1) = dll(1)
ll = .TranslateCoordinates(pTmp, acDisplayDCS, acWorld, False)
pTmp(0) = dur(0): pTmp(1) = dur(1)
ur = .TranslateCoordinates(pTmp, acDisplayDCS, acWorld, False)
End With
'' add a selection set
Set ss = ThisDrawing.SelectionSets.Add("ss")
'' select crossing window
ss.Select acSelectionSetWindow, ll, ur
'' return selection
Set SelectInPview = ss
End Function
'''
''' old technique
''' only works for coplaner views
'''
Function OldSelectInPview(objPViewPort As AcadPViewport) As AcadSelectionSet
Dim dblPCS(2) As Double
Dim vntPCS As Variant
Dim vntDCS As Variant
Dim vntWCS As Variant
Dim vntCenter As Variant
Dim dblLowerLeft(2) As Double
Dim dblUpperRight(2) As Double
Dim ssetViewPort As AcadSelectionSet
'Make the viewport active.
ThisDrawing.ActiveSpace = acPaperSpace
ThisDrawing.Application.ZoomExtents
objPViewPort.Display True
ThisDrawing.MSpace = True
ThisDrawing.ActivePViewport = objPViewPort
'Use the viewport width and height to find the distance from the center
of the viewport.
dblPCS(0) = objPViewPort.Width / 2
dblPCS(1) = objPViewPort.Height / 2
dblPCS(2) = 0#
vntPCS = dblPCS
'Translate the distance from center from paperspace display coordinate
system to display coordinate system.
vntDCS = ThisDrawing.Utility.TranslateCoordinates(vntPCS,
acPaperSpaceDCS, acDisplayDCS, True)
'Translate the distance from center from display coordinate system to
world coordinate system.
vntWCS = ThisDrawing.Utility.TranslateCoordinates(vntDCS, acDisplayDCS,
acWorld, True)
'Translate the center coordinates from paperspace display coordinate
system to display coordinate system.
vntCenter = objPViewPort.Center
vntDCS = ThisDrawing.Utility.TranslateCoordinates(vntCenter,
acPaperSpaceDCS, acDisplayDCS, False)
'Translate center coordinates from display coordinate system to world
coordinate system.
vntCenter = ThisDrawing.Utility.TranslateCoordinates(vntDCS,
acDisplayDCS, acWorld, False)
'Form the lower left and upper right corners of the viewport
dblLowerLeft(0) = vntCenter(0) - vntWCS(0)
dblLowerLeft(1) = vntCenter(1) - vntWCS(1)
dblUpperRight(0) = vntCenter(0) + vntWCS(0)
dblUpperRight(1) = vntCenter(1) + vntWCS(1)
'Create a selection set containing only entities that lie within the
coordinates of viewport.
Set ssetViewPort = ThisDrawing.SelectionSets.Add("SSET")
ssetViewPort.Select acSelectionSetCrossing, dblLowerLeft, dblUpperRight
Set OldSelectInPview = ssetViewPort
End Function
'''
''' test function
'''
Sub TestSelectInPview()
Dim ss As AcadSelectionSet
Dim ent As AcadPViewport
Dim pick As Variant
ThisDrawing.ActiveSpace = acPaperSpace
ThisDrawing.MSpace = False
ThisDrawing.Application.ZoomExtents
With ThisDrawing.Utility
.GetEntity ent, pick, vbCr & "Pick a pview: "
.InitializeUserInput 1, "New Old"
If "New" = .GetKeyword(vbCr & "Select function [Old/New]: ") Then
Set ss = SelectInPview(ent)
Else
Set ss = OldSelectInPview(ent)
End If
ss.Highlight True
ss.Delete
End With
End Sub
So, my recommendation is that you replace
the select stuff in the code you posted with
something like this:
'''
''' dwaynes function, with the select replaced
'''
Sub DwayneMain()
Dim intViewPortCount As Integer
Dim objPaperSpaceEntity As AcadEntity
Dim objPViewPort As AcadPViewport
Dim lngViewPortEntities As Long
Dim ssetViewPort As AcadSelectionSet
Dim objViewPortEntity As AcadEntity
intViewPortCount = -1
'Read through the paper space objects and process those that are
viewports.
For Each objPaperSpaceEntity In ThisDrawing.PaperSpace
If TypeOf objPaperSpaceEntity Is AcadPViewport Then
'The first PViewport returned is not a true paperspace viewport,
so skip it.
intViewPortCount = intViewPortCount + 1
If intViewPortCount > 0 Then
'' select entities visible in pview
Set ssetViewPort = SelectInPview(objPaperSpaceEntity)
'Set ssetViewPort = OldSelectInPview(objPaperSpaceEntity)
'Read through every entity in the selection set and store
data in arrays to process later.
For Each objViewPortEntity In ssetViewPort
Debug.Print objViewPortEntity.ObjectName
objViewPortEntity.Highlight True
Next objViewPortEntity
ssetViewPort.Delete
End If 'If intViewPortCount > 0
End If 'If TypeOf objPaperSpaceEntity Is AcadPViewport
'ThisDrawing.ActiveSpace = acPaperSpace
Next objPaperSpaceEntity
End Sub
Cheers-
rdh.
Dwayne
As I said, your views are all wcs coplaner - and thus
use affine transformations. Either technique will work
fine with these. But if distances in the view are not
equally projected (non-affine), the old method will fail.
An example of this is a perspective view.
Regarding the error, it sounds like you're missing the
following stuff prior to the pview iteration:
ThisDrawing.ActiveSpace = acPaperSpace
ThisDrawing.MSpace = False
ThisDrawing.Application.ZoomExtents
As Denis pointed out, you MUST do these first in order
for the iteration and selection to be effective.
Cheers-
rdh.
Well, the good news is that I finally have something that appears to work
100% of the time. I owe a lot to you and Denis. Your examples were very
helpful and your patience with a "green" AutoCAD/VBA programmer was
exceptional.
Thank you very much.
Dwayne
>Regarding the error, it sounds like you're missing the
>following stuff prior to the pview iteration:
>