Author Topic: Mid point of a blockref  (Read 10029 times)

0 Members and 1 Guest are viewing this topic.

Eloquintet

  • Gator
  • Posts: 3206
Re: Mid point of a blockref
« Reply #30 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;
Dan

AutoCAD Architecture 2015

Bob Wahr

  • Guest
Re: Mid point of a blockref
« Reply #31 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

Bob Wahr

  • Guest
Re: Mid point of a blockref
« Reply #32 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

ML

  • Guest
Re: Mid point of a blockref
« Reply #33 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?

Bob Wahr

  • Guest
Re: Mid point of a blockref
« Reply #34 on: April 29, 2008, 07:30:10 PM »
Not yet.  Haven't had huge amounts of free time.

ML

  • Guest
Re: Mid point of a blockref
« Reply #35 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

ML

  • Guest
Re: Mid point of a blockref
« Reply #36 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

ML

  • Guest
Re: Mid point of a blockref
« Reply #37 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

ML

  • Guest
Re: Mid point of a blockref
« Reply #38 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

Bob Wahr

  • Guest
Re: Mid point of a blockref
« Reply #39 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?

ML

  • Guest
Re: Mid point of a blockref
« Reply #40 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

ML

  • Guest
Re: Mid point of a blockref
« Reply #41 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

Bob Wahr

  • Guest
Re: Mid point of a blockref
« Reply #42 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.

ML

  • Guest
Re: Mid point of a blockref
« Reply #43 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


Bob Wahr

  • Guest
Re: Mid point of a blockref
« Reply #44 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