TheSwamp
Code Red => VB(A) => Topic started by: ML on May 05, 2008, 10:55:22 AM
-
Hi
I have a drawing with about 73 named views.
I am working on some code here;
With some help (Thanks Bob!)
This part is working well
For Each Ent In Sset
If TypeOf Ent Is AcadBlockReference Then
Set BlkRef = Ent
strName = BlkRef.Name
ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strName & vbCr
'*****MAKE SURE THE ABOVE FOLDER EXISTS*****
End If
Next Ent
And all it is doing is grabbing each blkref (1 per view) in the drawing and making a slide for each one, using the blkfef.name as the slide name
However, I want to be able to grab the lower left and upper right points of each view in the drawing as the pick points for each slide. I have the below code written, I am getting prompted for each point, the view is getting zoomed to window which is critical for this but I can not get the views to be recognized as an entity type in the sset or I am likely doing something wrong.
The other problem I am having is that by using the for each loop, I am ending up with a slide show.
All I want to do is to be prompted for each view, pick my points, then have the code assign the blockref name for that view as the name of each slide, then return the view back to the previous view and prompt for the next selection.
Also, with the views, each one needs to be restored (-view, r etc) in order for the frozen (views) layer state to be used.
Hope this makes sense?
Thanks!
M
Dim NView As AcadView
Dim Sset As AcadSelectionSet
Dim Ent As AcadEntity
Dim Pnt1 As Variant
Dim Pnt2 As Variant
Pnt1 = ThisDrawing.Utility.GetPoint(, "Pick First Point")
Pnt2 = ThisDrawing.Utility.GetPoint(, "Pick Second Point")
Set Sset = ThisDrawing.SelectionSets.Add("Sset")
Sset.Select acSelectionSetWindow, Pnt1, Pnt2
ZoomWindow Pnt1, Pnt2
For Each Ent In Sset
If TypeOf Ent Is AcadView Then
strName = NView.Name
ThisDrawing.SendCommand "-view" & vbCr & "r" & vbCr & strName & vbCr
End If
Next Ent
-
Ok,
With this code, I am almost have what I need
Sub CreateSlides()
On Error Resume Next
ThisDrawing.SelectionSets.Item("Sset").Delete
Dim Sset As AcadSelectionSet
Dim Ent As AcadEntity
Dim BlkRef As AcadBlockReference
Dim NView As AcadView
Dim strName As String
Dim VName As String
Dim sysFileDia As Integer
Dim Pnt1 As Variant
Dim Pnt2 As Variant
Pnt1 = ThisDrawing.Utility.GetPoint(, "Pick First Point")
Pnt2 = ThisDrawing.Utility.GetPoint(, "Pick Second Point")
Set Sset = ThisDrawing.SelectionSets.Add("Sset")
Sset.Select acSelectionSetWindow, Pnt1, Pnt2
ZoomWindow Pnt1, Pnt2
sysFileDia = ThisDrawing.GetVariable("FILEDIA")
ThisDrawing.SetVariable "FILEDIA", 0
For Each Ent In Sset
If TypeOf Ent Is AcadView Then
VName = NView.Name
GoTo Continue
End If
Next Ent
Continue:
For Each Ent In Sset
If TypeOf Ent Is AcadBlockReference Then
Set BlkRef = Ent
strName = BlkRef.Name
ThisDrawing.SendCommand "-view" & vbCr & "r" & vbCr & VName & vbCr
ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strName & vbCr
'*****MAKE SURE THE ABOVE FOLDER EXISTS*****
End If
Next Ent
ThisDrawing.SetVariable "FILEDIA", sysFileDia
End Sub
Except it is still asking me what view I would like to restore; I am not sure how to pass that in, so when I do vslide, the slide is still showing the view and construction lines, I just want to see the blkref.
And at the end, I would like to restore the view to previous.
Can anyone get me over this last huddle?
Thanks
M
-
Hadn't abandoned you, just busy.
Give this a look, needs to have the directory selection and text file bits added in.
Option Explicit
Sub MLides()
Dim objView As AcadView
Dim objViews As AcadViews
Dim varViewCen As Variant
Dim dblHgt As Double
Dim dblWdt As Double
Dim dblLLPt(0 To 2) As Double
Dim dblURPt(0 To 2) As Double
Dim objEnt As AcadEntity
Dim objBlkRef As AcadBlockReference
Dim objSelSet As AcadSelectionSet
Dim objSelSets As AcadSelectionSets
Dim strSldName As String
Set objViews = ThisDrawing.Views
For Each objView In objViews
varViewCen = objView.Center
dblHgt = objView.Height
dblWdt = objView.Width
dblLLPt(0) = varViewCen(0) - (dblWdt / 2)
dblLLPt(1) = varViewCen(1) - (dblHgt / 2)
dblLLPt(2) = 0
dblURPt(0) = varViewCen(0) + (dblWdt / 2)
dblURPt(1) = varViewCen(1) + (dblHgt / 2)
dblURPt(2) = 0
ZoomWindow dblLLPt, dblURPt
Set objSelSet = ThisDrawing.SelectionSets
For Each objSelSet In objSelSets
If objSelSet.Name = "blkpick" Then
ThisDrawing.SelectionSets.Item(strSet).Delete
Exit For
End If
Next
Set objSelSet = objSelSets.Add("blkpick")
objSelSet.Select acSelectionSetWindow, dblllpnt, dblurpnt
For Each objEnt In objSelSet
If TypeOf objEnt Is AcadBlockReference Then
Set objBlkRef = objEnt
strSldName = objBlkRef.Name
Exit For
End If
Next objEnt
ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strSldName & vbCr
Next objView
Next objView
End Sub
-
Don't forget to change filedia. I just did the views bit quickly and without testage, then flopped bits of the other stuff in. Will definitely take some up cleanage.
-
Hey Bob
I appreciate this
I had an idea that the center, height and width methods were the ticket but I was not making progress with it so I tried to change up.
Anyhow, I can see from trying the code that you posted that it is "going" to work; that is super cool!
It is creating the slides but not in the right directory, I am working on that part now, and I just put the filedia code in.
Also, at the end, I just put zoomprevious
So, let me see what I can do here
Mark
-
Bob
I'm still having a problem making this work properly but I thought of one thing
Why do I need to restore each view?
How about if I just freeze the layer that all of the views are on in the beginning of the module? DUHHHH
That should work.
Bob, this is the error that is getting generated
Command: MSLIDE
Enter name of slide file to create <K:\AutoCAD\Work
Related\SlideTemplate-Labls-test>: c:\tempslide\AUTHORIZ_LT
C:\tempslide\AUTHORIZ_LT.sld already exists, do you want to replace it?
[Yes/No] <N>:
Document "K:\AutoCAD\Work Related\SlideTemplate-Labls-test.dwg" has a command
in progress.
Do you see where I am going wrong?
Also, I am not really sure that we need to even write out the list of blocknames; I could be wrong.
If we were creating a slide library from DOS using slidelib, then we would absolutely need that txt file
Here is the code so far:
On Error Resume Next
ThisDrawing.SelectionSets.Item("blkpick").Delete
Dim objView As AcadView
Dim objViews As AcadViews
Dim varViewCen As Variant
Dim dblHgt As Double
Dim dblWdt As Double
Dim dblLLPt(0 To 2) As Double
Dim dblURPt(0 To 2) As Double
Dim objEnt As AcadEntity
Dim objBlkRef As AcadBlockReference
Dim objSelSet As AcadSelectionSet
Dim objSelSets As AcadSelectionSets
Dim intFile As Integer
Dim strFileName As String
Dim strSldName As String
Dim sysFileDia As Integer
sysFileDia = ThisDrawing.GetVariable("FILEDIA")
ThisDrawing.SetVariable "FILEDIA", 0
Set objViews = ThisDrawing.Views
For Each objView In objViews
varViewCen = objView.Center
dblHgt = objView.Height
dblWdt = objView.Width
dblLLPt(0) = varViewCen(0) - (dblWdt / 2)
dblLLPt(1) = varViewCen(1) - (dblHgt / 2)
dblLLPt(2) = 0
dblURPt(0) = varViewCen(0) + (dblWdt / 2)
dblURPt(1) = varViewCen(1) + (dblHgt / 2)
dblURPt(2) = 0
ZoomWindow dblLLPt, dblURPt
Set objSelSets = ThisDrawing.SelectionSets
Set objSelSet = objSelSets.Add("blkpick")
objSelSet.Select acSelectionSetWindow, dblLLPt, dblURPt
For Each objEnt In objSelSet
If TypeOf objEnt Is AcadBlockReference Then
Set objBlkRef = objEnt
strSldName = objBlkRef.Name
Exit For
End If
Next objEnt
ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strSldName & vbCr
strFileName = "C:\tempslide\" & ThisDrawing.GetVariable("dwgname") & ".lst"
'*****MAKE SURE THIS FOLDER EXISTS*****
intFile = FreeFile
Open strFileName For Append As #intFile
Print #intFile, strSldName & ".sld"
Close #intFile
Next objView
ThisDrawing.SetVariable "FILEDIA", sysFileDia
ZoomPrevious
Thanks
Mark
-
OK
Good and bad news
The good news is that I was not seeting the filedia correctly.
I fixed that and all of the slides got created
However, freezing the layer was not a good idea after all
If I did that, then what points are getting picked? DUHHH
So, if you can help me get each view to restore prior to the points getting picked, then I would say, it is a definite go
If I get some time here, I will try again as well
You definitely got the loop part working perfect
Mark
-
the points are being generated from the width and height of the view
-
Yes, I know
So, you wouldn't think that freezing the layer would effect anything, right?
There is definitely a noticeable difference when you do a manual mslide and when you run this code with the layer frozen.
I'm not sure what the problem is.
I was thinking that may be I need to get rid of the zoomwindow part of the code?
If we use a zoomwindow, we would need something on screen to be picked, wouldn't we?
I would love to just freeze the layer and be done but the slides are not coming out with the height and width sizes.
I didn't really look close enough at Bob's code, I am assuming the math is correct
Mark
-
Yes, I know
So, you wouldn't think that freezing the layer would effect anything, right?
There is definitely a noticeable difference when you do a manual mslide and when you run this code with the layer frozen.
I'm not sure what the problem is.
I was thinking that may be I need to get rid of the zoomwindow part of the code?
If we use a zoomwindow, we would need something on screen to be picked, wouldn't we?
I would love to just freeze the layer and be done but the slides are not coming out with the height and width sizes.
I didn't really look close enough at Bob's code, I am assuming the math is correct
Mark
The layer being frozen has nothing to do with anything. It's possible that the views that you have saved are different than a window based off of your rectangles. I haven't checked and don't have time right now to do so. I'll try this one one more time...I've said it several times and other people have as well. Step through your code line by line and see what's happening. When the code I posted zooms a windows based off of view "1", does the screen look the same as if you manually restore the view?
If you get rid of the zoomwindow part of the code, what will happen? Hint, mslide make a slide of the current display. If you don't change the current display and make a slide, what do you get? If you don't change it again, and make another slide, what do you get?
-
And now back for your posting pleasure..... *ding ding*
-
I'm not saying nuttin till I see my lawyer.
-
Was there any particular reason posts were removed from this thread?
-
am I correct in thinking that you have a named view for each block ?
Rather than messing about with named views, wouldn't it be easier to create a selection set of all blocks then loop through the selection set getting the bounding box of each block, and using those coordinates as your zoom window, then do the mslide thing ?
While X < SSet1.Count
For Each Xblk In SSet1
Inspt = Xblk.InsertionPoint
Dim Zcenter(0 To 2) As Double
Zcenter(0) = Inspt(0): Zcenter(1) = Inspt(1): Zcenter(2) = Inspt(2)
Dim BboxSP As Variant
Dim BboxEP As Variant
Xblk.GetBoundingBox BboxSP, BboxEP
Dim BboxP1(0 To 2) As Double
Dim BboxP2(0 To 2) As Double
BboxP1(0) = BboxSP(0): BboxP1(1) = BboxSP(1): BboxP1(2) = BboxSP(2)
BboxP2(0) = BboxEP(0): BboxP2(1) = BboxEP(1): BboxP2(2) = BboxEP(2)
ZoomWindow BboxP1, BboxP2
' DO THE MSLIDE BIT HERE
Next Xblk
X = X + 1
Wend
-
Hey Hendie
Yes, that would make perfect sense and Bob had provided some good code to do just that but the problem seems to be that the bounding box doesn't give you enough space around the block and the slide doesn't come out as well; the block tends to get too close to the edges of the slide. If there were a way to increase the bounding box size, that would be great.
Initially with code Bob supplied, I was able to grab the center of each bounding box which really helped position the blocks into place; that was a big time saver but for this particular thing, I think that I would prefer to pick points.
I think I will just go back to my initial thought and that was to make a simple pick 2 points, then have the slide name = the blkref name.
I really don't have a problem grabbing a few points for each slide, it is typing the names for each that I can live without.
Thanks Hendie, I will still look at your code.
Mark
-
you can add a zoom scale factor in after zooming to the bounding box.
usually a scale factor of 0.9x gives good results
ZoomScaled Scfactor, acZoomScaledRelative
-
Really
You know, I think Bob mentioned that as well
I am so bull headed sometimes.
I think I see exactly what I want and become blind to other good ideas; at first at least
Thanks Hendie!
-
Was there any particular reason posts were removed from this thread?
The posts I removed had nothing to do with the topic and everything to do with the heat of the moment. The OP requested that I delete the whole thread, I decided to pare it down as it may have some value.
-
Thanks Maverick!
It looks like we are back on the right track
Dam Mondays! :)
Mark
-
Was there any particular reason posts were removed from this thread?
The posts I removed had nothing to do with the topic and everything to do with the heat of the moment. The OP requested that I delete the whole thread, I decided to pare it down as it may have some value.
Alright... It's time I ask... What does OP stand for? (sorry for hi-jacking)
-
Original Poster maybe?
-
*Gives Duh a Strawberry Shortcake sticker* :-D
-
*Gives Duh a Strawberry Shortcake sticker* :-D
Why do you have Strawberry Shortcake stickers?!? Hmmmmm....??
Thanks, Duh! *gives Mav the 'evil eye'*
-
WooHoo I got a sticker!!!
-
Yeah, soon it will be EP for Ex-Poster sheewwwwwwwwwwww
-
Yeah, soon it will be EP for Ex-Poster sheewwwwwwwwwwww
:?
-
Yeah, soon it will be EP for Ex-Poster sheewwwwwwwwwwww
:?
:? x2
-
Hendie
I think this method is working very well actually.....using the boundingbox method
This is how I am using it and it seems to be doing it
Does that look correct to you?
Thanks
Mark
Dim Scfactor as Double
Scfactor = 0.9
ZoomWindow minExt, maxExt
ZoomScaled Scfactor, acZoomScaledRelative
-
Bob
It looks like you were right all along
Again, I'm sorry...
Either I misunderstand what you are telling me sometimes or get tunnel vision and don't pay close enough attention.
Using the views was "Not" my idea to start with but it looked good, so I went with it, but programmatically, using the boundingbox method, zoom windowon the blocks and further zooming it up actually works excellent.
I misunderstood when you suggested zoom to create a buffer...
Again, I apologize and your original code with the above zoomed scaled seems to really be the ticket.
Thank you,
Mark
-
ROFLMAO!
ML,
1. You attack the person who has been helping you over your last few threads.
2. The person who was helping you (BobW in this case) responds in kind to the unprovoked attack (I agree and support Bob 110%)
3. You then ask a Mod/Admin to delete the whole thread (but they only delete certain posts) because it makes you look foolish (I'm being VERY polite here with my choice of words)
4. You then say, that the person who was going OUT OF THEIR WAY to help you (BobW in this case), was RIGHT ALL ALONG.
I will say two things to you:
1. The members who respond to you are all quite knowledgeable and know what they are doing when they make suggestions, as that is all they are at the end of the day.
2. Grow up boy.
-
Mark,
First off, nobody reading this thread would have known that you apologised to Bob 4 times, because, as you said, it was in private.
Secondly, I'm neither happy nor un-happy about any of this.
Furthermore, members of this forum, including myself, have gone out of their way to help you, with responses and suggestions to your questions, but you don't seem to want to listen to good advice.
I can't and won't speak for anybody else, but personally, I'm jack of you - you just insulted another respected member of the community. If you want to run off, that's fine (it just proves my point) - don't let the door hit in you the arse on the way out.
-
...and there you go...more post deletions...
-
ML's last post he just deleted to bring some clarity for future searchers/members:
Listen
I apologized 4 times to Bob in pvt
Now once in public and you "Glenn" have effectively just re opened the wound
I hope you are happy?
Quote
2. Grow up boy.
That's real nice Glenn..So, who needs to grow up here?
Look, I apologized for the event, not necessarily what was said.
Glenn, you can agree 550%, do you really think I give a rat's ass what you think?
Just because people have knowledge, it does not give people them the right to talk to you however they like and that includes you.
It is people like you that confirm what I don't like about this forum.....the freaking arrogance
There are 100's of forums.
I don't need this s**t
If people don't feel as though I contribute as well, then I will gladly delete my profile
You know what
Let's make it easy
I will delete it right now
There! You happy Glenn
Thanks, you helped me make a tough decision real easy
Good night and good bye swamp!
Mark
-
*Sigh* Glenn R, Did I miss a post in there somewhere or did you pretty much just stick your nose where it wasn't involved, inflame an issue that had already been resolved (at least in here), and nominate yourself "Spokesman for the Swamp"?
Your opinion was neither asked for, nor needed.
1. The members who respond to you are all quite knowledgeable and know what they are doing when they make suggestions, as that is all they are at the end of the day.
2. Grow up boy.
1.The members who you are speaking for , which is exactly what you are attempting to do however you phrase it, do not need you to explain them. I'm quite sure they can take care of that themselves.
2. You could follow your own advice here and get past that childlike self-importance that makes you think you are right in all of your opinions.
ML asked that the thread be deleted b/c it had gotten way off track. I chose to pare out the posts and leave the thread. Get over yourself. If you're opinion is needed anywhere other than something you are directly involved in, I'm sure someone (maybe one of these future members you seem to champion) will summon you with a PM, I would imagine. Don't wait up.
-
Maverick, I had already decided long before this post, that it wasn't worth the abuse trying to help ML.
I watch his posts now to see how long the helper will hang in there.
(Jeff has proved to be the true gentleman).
ML has less and less people willing to help him as time goes on. Does that say anything?
perhaps there is a site called www.FreecodeIfYouAbuseMe.com.
-
www.FreecodeIfYouAbuseMe.com.
Wow! I like it :lol:
-
Maverick, I had already decided long before this post, that it wasn't worth the abuse trying to help ML.
I watch his posts now to see how long the helper will hang in there.
< ..>
Ditto !
Mav, Have a look back at some of the times Glenn has tried to help ML .. he does speak from experience ( If they haven't been deleted also)
-
Did I miss a post in there somewhere ...
Yes, several, from other threads, as Kerry pointed out, but they were deleted also.
1.The members who you are speaking for , ...
...
I can't and won't speak for anybody else, ...
...
-
Speaking of deleting posts, can I clean up this mess now? :)
-
Speaking of deleting posts, can I clean up this mess now? :)
I think it's safe to say that this one is officially done. ;-)