TheSwamp

Code Red => VB(A) => Topic started by: ML on April 25, 2008, 10:35:33 AM

Title: Mid point of a blockref
Post by: ML on April 25, 2008, 10:35:33 AM
Hi

Let me see if I can explain this;
Does anyone happen to have any code that will find the absolute mid point of a blockref?

For instance, I know a block has an insertion point, obviously but within the block are tons of entities, obviously

I guess this could be done a few ways, that is find the most centered entity within the blockref and get its point or get the most lower left and most upper right points of the lowest left and upper right entities in the block, then find the mid point based off of those points.

Does that make sense?

I could try to work on it later but this code would really benefit  me right now if anyone has something that could get it done.

I'd appreciate it

Thanks
Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 10:37:30 AM
Question, are you after the centroid of a shape that tightly conforms to the objects in the block, or the center of the bounding box for the block?
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 10:38:04 AM

Yes! Precisely Bob!
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 10:38:44 AM

I'm sorry,
I guess I would want the midpoint of the centroid

M
Title: Re: Mid point of a blockref
Post by: Guest on April 25, 2008, 10:42:24 AM
Have you looked into .GetBoundingBox??


<EDIT>
I suppose I should read a little bit closer next time.

Question, are you after the centroid of a shape that tightly conforms to the objects in the block, or the center of the bounding box for the block?
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 10:47:18 AM

No Matt
I never used BoundBox

I guess it could be a centroid or bounding box, if the bounding box is what I think it is.

I just need that midpoint.

I am being lazy, I need to insert about 75 blocks into a drawing using the midpoint of the blockref  and I am a bit tired of drawing rectangles.

Unfortunately, I don't have time right now to dive in and try to program it myself.

M
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 10:55:51 AM
It makes a pretty large difference in complexity.  If the centroid(~midpoint) of the bounding box, which is a rectangle from the minimum x&y of elements in the block to the maximum x&y, will work, it's fairly simple.  If you need the centroid of the geometry, the easiest way to get a close approximation that I can think of is to place a region for the bounding box of each entity in the block, then find the centroid with massprop.  Sounds to me like the former is what you're after.
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 11:11:46 AM

I see
Thanks Bob

Quote
It makes a pretty large difference in complexity.  If the centroid(~midpoint) of the bounding box, which is a rectangle from the minimum x&y of elements in the block to the maximum x&y, will work, it's fairly simple.

Yes, it is the first method that I would be after.
I like simple :)

M

Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 11:12:47 AM
as usual, quick, dirty, untested.  Own risk, blahblahblah

Code: [Select]
Option Explicit

Public Sub blkCent()
  Dim minExt As Variant
  Dim maxExt As Variant
  Dim pntCent(0 To 2) As Double
 
    lineObj.GetBoundingBox minExt, maxExt

  Dim strSet As String
  Dim strSetName As String
  Dim intGroup(0) As Integer
  Dim varGroup(0) As Variant
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
  Dim strBlkName As String
  Dim objBlkRef As AcadBlockReference
  Dim objEnt As AcadEntity
  Dim intCnt As Integer
 
  Set objSelSets = ThisDrawing.SelectionSets
  strSetName = 1
  intGroup(0) = 0
  varGroup(0) = "insert"
  KillSet strSetName
  Set objSelSet = objSelSets.Add(strSetName)
  objSelSet.Select acSelectionSetAll, , , intGroup, varGroup
  For Each objEnt In objSelSet
    If TypeOf objEnt Is AcadBlockReference Then
      objBlkRef = objEnt
      objBlkRef.GetBoundingBox minExt, maxExt
      pntCent(0) = (minExt(0) + maxExt(0)) / 2
      pntCent(1) = (minExt(1) + maxExt(1)) / 2
      pntCent(2) = (minExt(2) + maxExt(2)) / 2
    End If
  Next objEnt
End Sub

Function KillSet(strSet As String)
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
 
  Set objSelSets = ThisDrawing.SelectionSets
     
  For Each objSelSet In objSelSets
    If objSelSet.Name = strSet Then
      ThisDrawing.SelectionSets.Item(strSet).Delete
    Exit For
    End If
  Next

End Function

Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 11:21:10 AM

Wouldn't have it any other way :)
We can always clean it up later

Well, here goes nothing

Thanks so much Bob

I will let you know if it gets the job done

M

Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 11:23:56 AM

Bob

The lineobj variable is not set

Code: [Select]
lineObj.GetBoundingBox minExt, maxExt

I'm not sure what the line is for?

Shoud I declare the variable as an acadline?

Mark
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 11:24:24 AM

Or is the intent blockref.GetBoundingBox   ?
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 11:42:28 AM
Bob

I did not see how the line fit in; it is the blkref.boundingbox that we are after

I am not totally sure how you code is suppose to work.

I have like 50 blocks in this drawing, so I did some quick tweaking so that I can pick the blockref that I want, then I tried to print out the results and still nothing.

Here is my quick, down and dirty attempt

M

Code: [Select]
Option Explicit
Public Sub blkCent()
  Dim minExt As Variant
  Dim maxExt As Variant
  Dim pntCent(0 To 2) As Double
   
  'lineObj.GetBoundingBox minExt, maxExt

  Dim strSet As String
  Dim strSetName As String
  Dim intGroup(0) As Integer
  Dim varGroup(0) As Variant
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
  Dim strBlkName As String
  Dim objBlkRef As AcadBlockReference
  Dim objEnt As AcadEntity
  Dim intCnt As Integer
 
 
  Set objSelSets = ThisDrawing.SelectionSets
  strSetName = 1
  intGroup(0) = 0
  varGroup(0) = "insert"
  KillSet strSetName
  Set objSelSet = objSelSets.Add(strSetName)
  objSelSet.Select acSelectionSetAll, , , intGroup, varGroup
  objSelSet.SelectOnScreen intGroup, varGroup
  For Each objEnt In objSelSet
   'If TypeOf objEnt Is AcadBlockReference Then
    If objEnt.ObjectName = "AcDbBlockreference" Then
      objBlkRef = objEnt
      objBlkRef.GetBoundingBox minExt, maxExt
      pntCent(0) = (minExt(0) + maxExt(0)) / 2
      pntCent(1) = (minExt(1) + maxExt(1)) / 2
      pntCent(2) = (minExt(2) + maxExt(2)) / 2
    End If
     Debug.Print pntCent(0); pntCent(1)
  Next objEnt
End Sub
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 11:43:22 AM
yeah, that one.  I snagged the bounding box code from help and pasted it into something else I had so I wouldn't have to do any more typing than absolutely necessary.  Yeah, that's how lazy I am.
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 11:45:38 AM

Hey

We all do it man

Being resource (in my opinion) far outweighs accumulative knowledge.

Why re invent the wheel, right?

Unfortunately this is not going to get me what I beed right now but may be I will look at it later.

Thanks again
Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 11:47:57 AM
try this

Code: [Select]
Option Explicit
Public Sub blkCent()
  Dim minExt As Variant
  Dim maxExt As Variant
  Dim pntCent(0 To 2) As Double
   
  'lineObj.GetBoundingBox minExt, maxExt

  Dim strSet As String
  Dim strSetName As String
  Dim intGroup(0) As Integer
  Dim varGroup(0) As Variant
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
  Dim strBlkName As String
  Dim objBlkRef As AcadBlockReference
  Dim objEnt As AcadEntity
  Dim intCnt As Integer
 
 
  Set objSelSets = ThisDrawing.SelectionSets
  strSetName = 1
  intGroup(0) = 0
  varGroup(0) = "insert"
  Set objSelSet = objSelSets.Add(strSetName)
  'objSelSet.Select acSelectionSetAll, , , intGroup, varGroup
  objSelSet.SelectOnScreen intGroup, varGroup
  For Each objEnt In objSelSet
   If TypeOf objEnt Is AcadBlockReference Then
   ' If objEnt.ObjectName = "AcDbBlockreference" Then
      Set objBlkRef = objEnt
      objBlkRef.GetBoundingBox minExt, maxExt
      pntCent(0) = (minExt(0) + maxExt(0)) / 2
      pntCent(1) = (minExt(1) + maxExt(1)) / 2
      pntCent(2) = (minExt(2) + maxExt(2)) / 2
    End If
     Debug.Print pntCent(0); pntCent(1)
  Next objEnt
End Sub
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 02:36:19 PM

Bob

That did not quite get it, then I looked at the acad example as well
I started to screw with it a bit then thought I best just finish "this time" manually
I had to do it with 77 blocks

OK, so I finished that task, next time, I need to have an automated way of getting it.

If I get a few minutes this afternoon, I will look at it more.

Bob, would the bound box be similar to drawing a rectangle around the whole blockref?

If so, that is precisely what I need.

I see that you did the required math to capture the midpoint, I will need to expound; I think it would be good if when I select the blockref, that midpint will become my picked point, then I can move the blockref right into place.

Think it can be done?

Any help is certainly (as always) appreciated

Thanks!

Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 03:06:15 PM

Bob

That did not quite get it, then I looked at the acad example as well
I started to screw with it a bit then thought I best just finish "this time" manually
I had to do it with 77 blocks
hmm.  ok.

OK, so I finished that task, next time, I need to have an automated way of getting it.

If I get a few minutes this afternoon, I will look at it more.
OK, shout if you get stumped.
Bob, would the bound box be similar to drawing a rectangle around the whole blockref?

If so, that is precisely what I need.
yep, precisely.
I see that you did the required math to capture the midpoint, I will need to expound; I think it would be good if when I select the blockref, that midpint will become my picked point, then I can move the blockref right into place.

Think it can be done?
yep.  You can, after selection, prompt for a "move to point," then move it programatically.
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 05:01:35 PM

Thanks Bob!

I will take a look at it.

Unfortunately, we are under the gun to get this done by Monday.

I will definitively look at it next week. If I get jammed up, may be you could lend me a hand.

Thanks Bob

Have a good weekend

M


Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 07:55:23 PM
I only tried it once, and the block was fairly simple, but this worked for me.
Code: [Select]
Option Explicit
Public Sub blkCent()
  Dim minExt As Variant
  Dim maxExt As Variant
  Dim pntCent(0 To 2) As Double
  Dim strSet As String
  Dim strSetName As String
  Dim intGroup(0) As Integer
  Dim varGroup(0) As Variant
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
  Dim objBlkRef As AcadBlockReference
  Dim objEnt As AcadEntity
  Dim pntMoveTo As Variant
 
  Set objSelSets = ThisDrawing.SelectionSets
  strSetName = 1
  intGroup(0) = 0
  varGroup(0) = "insert"
  KillSet strSetName
  Set objSelSet = objSelSets.Add(strSetName)
  objSelSet.SelectOnScreen intGroup, varGroup
  For Each objEnt In objSelSet
   If TypeOf objEnt Is AcadBlockReference Then
      Set objBlkRef = objEnt
      objBlkRef.GetBoundingBox minExt, maxExt
      pntCent(0) = (minExt(0) + maxExt(0)) / 2
      pntCent(1) = (minExt(1) + maxExt(1)) / 2
      pntCent(2) = (minExt(2) + maxExt(2)) / 2
    objBlkRef.Highlight True
    pntMoveTo = ThisDrawing.Utility.GetPoint(, "Select Destination Point: ")
    objBlkRef.Move pntCent, pntMoveTo
    End If
  Next objEnt
End Sub

Function KillSet(strSet As String)
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
 
  Set objSelSets = ThisDrawing.SelectionSets
     
  For Each objSelSet In objSelSets
    If objSelSet.Name = strSet Then
      ThisDrawing.SelectionSets.Item(strSet).Delete
    Exit For
    End If
  Next

End Function
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 08:03:49 PM

Hey Bob
Are you still in work also?
Man! No rest for the weary...shewwww

Hey, I just tried the code, it seems to be working perfectly
Good job!

I really appreciate it

I will "definitely" look at it closer on Monday

Mark
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 08:12:30 PM

BOB

That kicks Ass!

Man I could have used that 7 hours ago

It will certainly come in handy for the next batch that I do

I never want to see a rectangle again :)

Thanks again!!!

Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 08:56:04 PM
Glad you like it.  I would still throw in some error handling if I was you.  I stripped out what was in the one I started with though don't ask me why.  I had a couple of minutes before class started this evening and was able to knock it out.  It actually wouldn't hurt to rewrite the whole thing if you get the time.  Having come from a larger, screwier routine, it could be more clean.
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 09:13:58 PM

Yes, it works very well, thanks Bob!
I tried it on like 4 examples and it was exactly what I needed
I did not get any errors but if I encounter any, I will certainly address them

I will definitely look at it closer next week.
I will clean it or shorten up a bit but the method is dead on.

Before class huh?

Like I said, no rest for the weary :)

The next thing I am going to do is have ACAD write out the script files for me, then I think I will be in great shape for creating slides.

Not sure that I told you that is what I was doing?

I made a template with 75 viewports in Model, with center ticks.
1 viewport per slide.
Defined the viewport boundaries for each one.

Then wrote a script that basically repeats 75 times
view
r
5
mslide
Slidename

Then from Dos, using Slidelib, I created the slide library

We are creating image tiles for all of our symbol libraries

A lot of work upfront but worth it in the end.

Thanks again Bob

I appreciate all of the help!

M



Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 09:28:58 PM
I've got a vba routine at the office that writes scripts, or purports to at any rate, I don't think I ever tried it.  My counterpart in one of our other offices turned it up a while back.  I always do mine manually.  Not the most efficient way, but it works and it's one of those old dog/new trick things.  PM me monday morning and I'll dig it up, if you want it.

Side Note:How many people here have ever written a text file with copy con>filename.txt then editted it with edlin?

Them was the days.  Not necessarily the good days, but the days.
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 09:58:05 PM

Hey Bob

Yes, I would like to see that code

Bob, are you kidding? DOS is still alive and well as far as I am concerned.

I write out from DOS all of the time, to get a printout of directories and files

It is priceless

A matter of fact, to do slidelib, you must use DOS, I believe

Ever use it?

As far as scripts, that is a cool way to get all your drawings into an scr file but what about this stuff:
view
r
5
mslide
Slidename

I guess I would just output my blocknames to an scr file from DOS, then paste the rest down like you said.
Still, I think I can do something here.....

If I show you the template and you are interested, we could probably grab each viewport
Pseudo code:
Thisdrawing.Sendcommand "view" & VbCr & "r" & viewport.name & "mslide" & VbCr & blkref.name & VbCr

So, for each viewport, we could just write it out to the debugger window or better yet, I could write it out to an external .scr file from VBA....

OMG...is my brain still functioning? I can't believe it.

Hey Bob

This is not  the most effective tool but  at one point I was trying to expound on it, just got stuck.

Code: [Select]
Dim FSO,WshNetwork,WshShell,svDialog
 Dim objFile,intReturn
 Dim txtsv 'String Variables

 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set WshNetwork = CreateObject("WScript.Network")
 Set WshShell = CreateObject ("WScript.shell")
 Set svDialog = CreateObject("SAFRCFileDlg.FileSave")

'Open File Save Dialog Box
  svDialog.FileName = "Temp.txt" 
  svDialog.FileType = "Text Files (*.txt)"
 
  intReturn = svDialog.OpenFileSaveDlg
  txtsv = svDialog.FileName

'Create, save and close file
 If intReturn Then
  Set objFile = FSO.CreateTextFile(txtsv)
  objFile.Close
 Else
  Wscript.Quit
 End If
 
 'Output Current Directory:

 '/k is a cmd.exe switch, it means keep the command prompt window open and wait for the next instruction.
 '/c closes the command prompt window before you see it

 WshShell.Run "cmd /C CD & dir *.dwg > dwg.txt /s /b &"
 
 
 Set WshShell = Nothing

I think you know vbs?

Just copy that code into a txt file, saveas a .vbs file and double click

It needs work but do you think I use DOS?  LOL

OK, I'll message you on Monday

Mark
Title: Re: Mid point of a blockref
Post by: ML on April 25, 2008, 10:01:40 PM

BOB,
If you want to try to use that vbs file, don't rename the file, just browse to the directory that you want to write from/to and the temp file will get overwritten with a file from DOS called temp.
As I said, it needs work but it gets the job done.

After the data is written out, you can then rename the file to whatever

Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 25, 2008, 10:31:28 PM
re: slidelib, yes I use it
re: vbscript - I've done a bit of stuff but not a lot
re: the template, send it to me.  Not sure if I'll have any time to mess with it next week but I might.
 I don't see a way to make a slide via vba other than sendcommand and mslide which is unfortunate.

Title: Re: Mid point of a blockref
Post by: ML on April 26, 2008, 02:18:22 PM

Yes, that is a share that you can not do mslides from VBA, via the API but at least we can do something with the sendcommand
I think acad considers image tiles legacy when in fact, I think they are still a great asset

Once the symbol library is done, if you want to add a slide, you just mslide the new block out, add the slide name to the .txt file and run slidelib again from DOS to re create the library.

I think you probably assumed by now that the code that you wrote for me was to center each blockref into the respective vport.

With that code, you can insert all of your blocks into the template I have, then quickly center each block into its respective vport.

The very first vport was created by doing a zoom extents, then drawing the viewport.
After that, I just arrayed the vport across and down.

After you freeze the viewports, you have to go into each one and select update layers, then acad will remember that the frozen state is the current layer state. This way when you make the slides via a script or however, the vports will be frozen in each slide.
The only time you would really need to do an update layers on a vport again is if you add one ( I think) but definitely if you have to re scale the vports for a new batch of blocks. I had to do that once and an update layers was necessary.

Hmmmm.there may be a way in VBA to update all vports at once; didn't think of that.

vb-scripting:
As far as vb-scripting, I love it. It has so many great uses.
I think the cool thing is that you can incorporate it into VBA as well as using it stand alone in a .vbs file.
In which case only a double click is necessary.

Off topic a bit:
Myself and CM have had a few debates with vbs.
I know that VBA has a way to write out to .txt files but I love the The textstream method in The File SystemObject of vbs.
I would not say that one way is better then the other but I will say that the textstream method with FSO is certainly a lot more flexible as I can employ it from outside of AutoCAD. Anyone that has seen some of my code has seen that I like to mix it up.
Not to mention that, if I do the vbs code in ACAD-VBA, I can copy the code snippets to vbs and do some things.
Again, that is all a personal preference.

Hey Bob,
I found a great "free" program on line; it is called vbsedit
If you want to buy it, I think it is like $47 but you can also just keep hitting evaluate if you'd like.

www.vbsedit.com
 (http://www.vbsedit.com)
It has a built in debugger, tons of examples that you can use immediately plus it uses intellisense like VBA which is outstanding.
It also allows you to put your own code snippets in to be saved for later use.
There is also an output window that works just like locals does in VBA.
For anyone that wants to learn VB-Scripting quickly, this program is great.
To get around the evaluate message, I use the program for code examples, getting methods and debugging, then I switch over to another editor for easy tweaks, that don't require me to run the code from vbsedit.
It is certainly worth the $47, I may even go ahead and buy it.
Anyhow, I would definitely strongly suggest any serious programmer to at least check it out
I am not sure about Visual Studio because I do not own it but these features for Vb-scripting be built into there as well.

Mark





Title: Re: Mid point of a blockref
Post by: ML on April 26, 2008, 02:19:17 PM

If you go to vbsedit, there is a flash tutorial; I was just watching it again
Man! Hats off to whomever developed that program; it is brilliant

M
Title: Re: Mid point of a blockref
Post by: Eloquintet on April 28, 2008, 04:07:49 PM
Hey this is nice. I'm currently having to place many blocks centered in a grid so this will come in handy for me as well. The only problem I was having is not being able to specify the midpoint between 2 points as my destination so I don't need to draw lines on my grid. I'm using 2002 and have created a button with this in it but it doesn't work:

_non;'cal (cur + cur)/2;
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 28, 2008, 05:11:24 PM
Code: [Select]
sub PickAWinner()
Dim pntOne as variant
dim pntTwo as variant
dim pntFriendsNose(0 to 2) as double

pntone=thisdrawing.getpoint(,"You can pick your friends: ")
pnttwo=thisdrawing.getpoint(,"You can pick your nose: ")
      pntFriendsNose(0) = (pntone(0) + pnttwo(0)) / 2
      pntFriendsNose(1) = (pntone(1) + pnttwo(1)) / 2
      pntFriendsNose(2) = (pntone(2) + pnttwo(2)) / 2
end sub
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 29, 2008, 12:52:50 PM
hEY mARK,

cHECK THIS OUT AND SEE IF IT'S WHAT YOU'RE AFTER.  sfcl, sorry

Code: [Select]
Option Explicit
Public Sub blkCent()
  Dim minExt As Variant
  Dim maxExt As Variant
  Dim strSetName As String
  Dim intGroup(0) As Integer
  Dim varGroup(0) As Variant
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
  Dim objBlkRef As AcadBlockReference
  Dim objEnt As AcadEntity
  Dim strName As String
  Dim sysFileDia As Integer
  Dim strFileName As String
  Dim strWriteLine As String
  Dim intFile As Integer

  Set objSelSets = ThisDrawing.SelectionSets
  strSetName = 1
  intGroup(0) = 0
  varGroup(0) = "insert"
  KillSet strSetName
  Set objSelSet = objSelSets.Add(strSetName)
  objSelSet.Select acSelectionSetAll, , , intGroup, varGroup
  sysFileDia = ThisDrawing.GetVariable("FILEDIA")
  ThisDrawing.SetVariable "FILEDIA", 0
  For Each objEnt In objSelSet
   If TypeOf objEnt Is AcadBlockReference Then
      Set objBlkRef = objEnt
      strName = objBlkRef.Name
      objBlkRef.GetBoundingBox minExt, maxExt
      ZoomWindow minExt, maxExt
      ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strName & vbCr
      strFileName = "C:\tempslide\" & ThisDrawing.GetVariable("dwgname") & ".lst"
      '*****MAKE SURE THIS FOLDER EXISTS*****
      intFile = FreeFile
      Open strFileName For Append As #intFile
      Print #intFile, strName & ".sld"
      Close #intFile
    End If
  Next objEnt
  ZoomExtents
  ThisDrawing.SetVariable "FILEDIA", sysFileDia
End Sub

Function KillSet(strSet As String)
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
 
  Set objSelSets = ThisDrawing.SelectionSets
     
  For Each objSelSet In objSelSets
    If objSelSet.Name = strSet Then
      ThisDrawing.SelectionSets.Item(strSet).Delete
    Exit For
    End If
  Next

End Function
Title: Re: Mid point of a blockref
Post by: ML on April 29, 2008, 07:17:11 PM

Hey Bob

I was at a company wide meeting for 2 days

Checking my e-mail from home

From looking at it, it looks good,  Iwill need to try it when I get in the office tomorrow

Mark

PS: Did you take a look at that vbsedit link?
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 29, 2008, 07:30:10 PM
Not yet.  Haven't had huge amounts of free time.
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 10:30:34 AM

Bob

I am back in the office
I think that is a good thing..hmmmmm   :-(

I have to do a few things this morning but I will definetely look at the code this afternoon

M

PS: Have you ever used the proper function? :)
Quote
hEY mARK,

cHECK THIS OUT AND SEE IF IT'S WHAT YOU'RE AFTER.  sfcl, sorry
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 11:14:32 AM

Bob

I still need to try it but I think you will like this, if you haven't used this method yet.

In the part of the code where it says, make sure folder exists...

Incorporate this code:

Note: First, Set a reference in VBA to
Microsoft Shell Controls and Automation

Code: [Select]
Sub TryMeBob ()
'Create new folder and get the path to the new folder
 Dim oShell As Shell32.Shell
 Dim oFolder As Shell32.Folder
 Dim oItems As Shell32.FolderItems
 Dim Item As Shell32.FolderItem
 Dim Path As String

 Set oShell = New Shell 'Get the ActiveX interface to shell32.dll
 Set oFolder = oShell.BrowseForFolder(0, "Select a path ", 0)
 
 If oFolder Is Nothing Then
  MsgBox "Path not selected... Exiting!!"
  Exit Sub
 End If
 
 Set oItems = oFolder.Items
 Set Item = oItems.Item
 
 Path = Item.Path & "\"

End Sub
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 11:27:46 AM

To try this code in a real example, we could write out our layers (txt file) to a folder that we create on the fly

M

Code: [Select]
Sub CreateFolderWriteLayers()

'Create new folder and get the path to the new folder
 Dim oShell As Shell32.Shell
 Dim oFolder As Shell32.Folder
 Dim oItems As Shell32.FolderItems
 Dim Item As Shell32.FolderItem
 Dim Path As String

 Set oShell = New Shell 'Get the ActiveX interface to shell32.dll
 Set oFolder = oShell.BrowseForFolder(0, "Select a path ", 0)
 
 If oFolder Is Nothing Then
  MsgBox "Path not selected... Exiting!!"
  Exit Sub
 End If
 
 Set oItems = oFolder.Items
 Set Item = oItems.Item
 
 Path = Item.Path & "\"
 
'-------------------------------------------------
 
'For demonstration, write out your ACAD drawing layers to a .txt file (using drawing name = filename) and place it in your new folder
 Dim MyFile As Variant
 Dim Dwgname As String

 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set WshNetwork = CreateObject("WScript.Network")

 Dwgname = UCase(Left$(ThisDrawing.Name, Len(ThisDrawing.Name) - 4))

 Set MyFile = FSO.CreateTextFile(Path & Dwgname & ".Txt", True)

 For Each Layr In ThisDrawing.Layers
  MyFile.WriteLine Layr.Name
 Next Layr

 MyFile.Close

 End Sub
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 03:10:57 PM

BOB

I tried your code for making the slides
Awesome!!!!!!!!

Now, I see that the lst (text file) of each slide was created with all of the slides in the directory C:\tempslide
However I did not do a vslide on any of them yet.

Have you created a slide library with them?

If so, how did it look?

I need to examine your code further.

OK, I think what you did was used the bounding box of each blkref to create the slides;
If so, that will not work for me.

I need to get the extmin and extmax of each viewport as then are defining my boundaries for each slide.
Did you get that template that I sent to you?

As far as naming the slides, the was perfect, using the blkref names.

Also, I have seen freefile but I never quite understood how it worked?

Thanks!

Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 30, 2008, 03:34:18 PM
Yea, got t and used it.  Didn't see any viewports which is why I didn't use them.  What you've got are named views, not viewports.  Different animals.  Do you want the slides named the same as the block name, or the view name?
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 03:58:11 PM

I'm sorry

The named views are on layer temp, they may have been frozen, I apologize

Naming the slides with the blockrefs names is perfect but the points need to be grabbed from the min and max of each named views

Some people may use rectangles, that is fine too

Where the named views will come in handy is when we write the script.

Because we can do something like this:

Code: [Select]
view
r
3
mslide
Blkref name

So, if we go left to right, top to bottom, and grabbed the min and max of each named view, that would be perfect.

Then
the script is saying

restore
view 3
mslide
blkref.name

There is a good reason why I prefer named views or rectangles; the blocks just look a lot more centered that way.

I thought it was a good idea to use named views so that we have a name to grab when writing out scripts
If we are interating through the named views, then it will be # 1 through whatever

What do you think?

Mark
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 04:01:27 PM

Bob

Forget this line
Quote
So, if we go left to right, top to bottom

If the views are named in numeric order, then it will be fine
The code will just iterate through the named view collection accordingly

Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 30, 2008, 04:07:51 PM
It's not hard to name them by the view name, or the block name, just need to know which you prefer.  I don't really see the point in scripting this, seems as easy, easier actually, just to make them programatically.
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 04:12:24 PM

Yes, yes

You have a great point as you just demonstrated

Why script them when you can do it as you previously demonstrated.

I would definitely prefer the the blkref name as the name of the slide

For the text file, I did this:
Code: [Select]
Dwgname = UCase(Left$(ThisDrawing.Name, Len(ThisDrawing.Name) - 4))

strFileName = "C:\tempslide\" & Dwgname & ".txt"

Just to get the extension out of the text file name; that is so minor though

Mark

Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 30, 2008, 05:00:54 PM
what do you think about this?
Code: [Select]
Option Explicit
Public Sub blkCent()
  Dim minExt As Variant
  Dim maxExt As Variant
  Dim pntLL(0 To 2) As Double
  Dim pntUR(0 To 2) As Double
  Dim strSetName As String
  Dim intGroup(0) As Integer
  Dim varGroup(0) As Variant
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
  Dim objBlkRef As AcadBlockReference
  Dim objEnt As AcadEntity
  Dim strName As String
  Dim sysFileDia As Integer
  Dim strFileName As String
  Dim strWriteLine As String
  Dim intFile As Integer

  Set objSelSets = ThisDrawing.SelectionSets
  strSetName = 1
  intGroup(0) = 0
  varGroup(0) = "insert"
  KillSet strSetName
  Set objSelSet = objSelSets.Add(strSetName)
  objSelSet.Select acSelectionSetAll, , , intGroup, varGroup
  sysFileDia = ThisDrawing.GetVariable("FILEDIA")
  ThisDrawing.SetVariable "FILEDIA", 0
  For Each objEnt In objSelSet
   If TypeOf objEnt Is AcadBlockReference Then
      Set objBlkRef = objEnt
      strName = objBlkRef.Name
      objBlkRef.GetBoundingBox minExt, maxExt
      pntLL(0) = ((minExt(0) + maxExt(0)) / 2) - 67.93
      pntLL(1) = (minExt(1) + maxExt(1)) / 2 - 43.04
      pntLL(2) = (minExt(2) + maxExt(2)) / 2
      pntUR(0) = ((minExt(0) + maxExt(0)) / 2) + 67.93
      pntUR(1) = (minExt(1) + maxExt(1)) / 2 + 43.04
      pntUR(2) = (minExt(2) + maxExt(2)) / 2
      ZoomWindow pntLL, pntUR
      ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strName & vbCr
      strFileName = "C:\tempslide\" & ThisDrawing.GetVariable("dwgname") & ".lst"
      '*****MAKE SURE THIS FOLDER EXISTS*****
      intFile = FreeFile
      Open strFileName For Append As #intFile
      Print #intFile, strName & ".sld"
      Close #intFile
    End If
  Next objEnt
  ZoomExtents
  ThisDrawing.SetVariable "FILEDIA", sysFileDia
End Sub

Function KillSet(strSet As String)
  Dim objSelSet As AcadSelectionSet
  Dim objSelSets As AcadSelectionSets
 
  Set objSelSets = ThisDrawing.SelectionSets
     
  For Each objSelSet In objSelSets
    If objSelSet.Name = strSet Then
      ThisDrawing.SelectionSets.Item(strSet).Delete
    Exit For
    End If
  Next

End Function
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 05:19:51 PM

Bob

I will need to try it but I am wondering about this part

Code: [Select]
pntLL(0) = ((minExt(0) + maxExt(0)) / 2) - 67.93
      pntLL(1) = (minExt(1) + maxExt(1)) / 2 - 43.04
      pntLL(2) = (minExt(2) + maxExt(2)) / 2
      pntUR(0) = ((minExt(0) + maxExt(0)) / 2) + 67.93
      pntUR(1) = (minExt(1) + maxExt(1)) / 2 + 43.04
      pntUR(2) = (minExt(2) + maxExt(2)) / 2

I'm not sure why you have the trailing numbers? The +/- 's
The reason I say this is because the scale of that template can change as per what I am doing

For example, if I am doing symbols, then the views will be smaller
If I am doing label type symbols, the views will be larger.

I'm sorry, I should have told you that I may scale the template up or down

The views are nothing more then closed polylines

For each boundary
 get the llpnt and the urpnt
 Make the slide
Next boundary

Wouldn't that work?

Let me try the code

Thanks!

Mark
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 05:27:38 PM

Bob

Good try but still not quite right

I think it would be fine to just be prompted for 2 points
llpnt and urpnt

After you pick the points, the slide gets created with all the rest of your code

So, if I have to pick 2 points 75 times, that is still not the end of the world

Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 30, 2008, 05:28:55 PM
meh.  Knew that was a chance, tried to cheat it because it was less code change.  I'll do it the other way but probably not before tomorrow.
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 05:31:24 PM
Bob

If you incorporated this in

restore, view 3 (respective number), mslide blkref.name

That would do it

You see, I define the boundaries for each view upfront

If you restore each view, then grab the minext and maxext pnts of that boundary, then the slide would get created exactly as inteneded

Or a zoom window of each closed boundary (polyline), that would also do it

Thanks!

Mark
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 05:33:10 PM

LOL

I'm sorry man!

You're doing a great job, you probably just didn't know all of my manual methodologies upfront.

If you nail this the way I am suggesting, then it would work with rectangles as well as named views

It would be very cool

Mark
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 05:36:02 PM

I think that this
Code: [Select]
For each boundary
 get the llpnts and the urpnts
 Make the slide
Next boundary
Would be the best and most flexible method by far.

This would work with closed plines, named views and rectangles...as they are all treted the same, I believe

Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 30, 2008, 05:39:19 PM
What are your criteria for setting the view size?
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 05:46:34 PM

It is a good old fashion method called eye balling it  :lmao:

Seriously!

Think of each rectangle (view, respectively) as an image in an image tile

So, if you were to do a zoom extents and draw a box, then you would have your first image tile
If the block looks good centered in that box, then you zoom out and array that box as many times as necessary.

I really do think by grabbing the ll and ur points of each boundary would be the most dynamic way to hit it

So, for each rectangle, you are msliding whatever is inside each rectangle

The question then is how do you retreive the block name inside of each rectangle

Man! i don't know that answer

Mark
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 05:50:43 PM

Bob

Let's simplify this

Prompt the user to select the blockref, then you prompt them to pick two points; that is the lower left and upper right points of the closed pline.

After the user selects the blkref, we store that blkref name in a variable, get the points and create the slide using the blkref name

What do you think?

Between the code you did for centering the blocks (bounding box code) and the code I am suggesting here, we would move right through 75 mslides.

Mark
Title: Re: Mid point of a blockref
Post by: Bob Wahr on April 30, 2008, 06:10:42 PM
The question then is how do you retreive the block name inside of each rectangle
That's not hard but I still don't like one click each, much less two.  What about zooming in on the bounding box, then zooming out .9x (or whatever) to give a little buffer?
Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 06:25:27 PM

Really?

I like the idea of picking the blockref then the two boundary points.
I guess that can really screw up the works if you miss.

Bob, I need the whole rectangle, point to point.

No zoom involved, unless you do a zoom window on the lower and upper corner of each closed polyline (boundary) then grab the blkref name, then do the mslide.

Think of each corner of the rectangle as a corner in the image tile box.

However the block looks inside the rectangle is exactly how it will look in the image tile.

This is why we scale up or down for different block types

Mark


Title: Re: Mid point of a blockref
Post by: ML on April 30, 2008, 06:29:48 PM

Quote
What about zooming in on the bounding box, then zooming out .9x (or whatever) to give a little buffer?

No buffer necessary

Bob, suing that template that I sent to you, type -view at the command line, then select r for restore, then type in 1.

It will restore view 1. The way you see it there is exactly how I will need the slide to look

Each view is created by defining the boudary, end point to end point

Does that make sense?

Thanks
Mark
Title: Re: Mid point of a blockref
Post by: ML on May 01, 2008, 03:26:52 PM

Hey Bob

I decided to try to write out a script in the debugging window, for now.
If all works out, I may even write it out to an .scr file

The code seems to be working well:
Code: [Select]
Sub WriteScript()

Dim BlkRef As AcadBlockReference
Dim Ent As AcadEntity
Dim NView As AcadView

For Each Ent In ThisDrawing.ModelSpace
 If TypeOf Ent Is AcadBlockReference Then
  Set BlkRef = Ent
  For Each NView In ThisDrawing.Views
   Debug.Print "view" & vbCrLf & "r" & vbCrLf & NView.Name & vbCrLf & "mslide" & vbCrLf & Ent.Name
  Next NView
 End If
Next Ent

End Sub
Except that I have 73 named views and it is only writing out 34 to 73

Any idea why?

Thanks!
Mark
Title: Re: Mid point of a blockref
Post by: ML on May 01, 2008, 03:40:38 PM

OK

I've answered my own question  :laugh:

Evidentally, the debugging window has a limitation to how many lines can be written to it

I just threw together this code real quick

Code: [Select]
Sub TestCode()

Dim BlkRef As AcadBlockReference
Dim Ent As AcadEntity
Dim NView As AcadView
Dim FSO, MyFile

Set FSO = CreateObject("Scripting.FileSystemObject")

Set MyFile = FSO.CreateTextFile("c:\test.scr", True)

For Each Ent In ThisDrawing.ModelSpace
 If TypeOf Ent Is AcadBlockReference Then
  Set BlkRef = Ent
  For Each NView In ThisDrawing.Views
   MyFile.WriteLine "view" & vbCrLf & "r" & vbCrLf & NView.Name & vbCrLf & "mslide" & vbCrLf & Ent.Name
  Next NView
 End If
Next Ent

MyFile.Close

End Sub

And it successfully wrote out all of the info to a .scr file

That is pretty cool

The only thing I am still unsure about is why some of the numbers (named view names) are not all in order in the scr file?

Also, I need to make sure that each block is getting assigned to the right named view in the script.

Any help here would be appreciated

Thanks
Mark