Topic: Absolute Center of Sset

[fixo]

    For Each objEnt In objSS
        objEnt.GetBoundingBox varMinBound, varMaxBound
        If varMinBound(0) < minX Then minX = varMinBound(0)
        If varMinBound(1) < minY Then minY = varMinBound(1)
        If varMaxBound(0) > maxX Then maxX = varMaxBound(0)
        If varMaxBound(1) > maxY Then maxY = varMaxBound(1)
    Next objEnt
    Dim cpt(2) As Double
    cpt(0) = (minX + maxX) / 2
    cpt(1) = (minY + maxY) / 2
    ReturnMid = cpt

End Function

I'm learning something new from you
every time, thanks again

~'J'~

[CadRover]

Yes, Fixo
That will get you the midpoints of each ent in the selection set; it still does not seem to address what I was originally hoping for.

I'm not even sure it can be done.

hmmmmm.....may be I need to change my selection method from selectonscreen to selectcrossing.

Not sure, I am stomped

CADR

[Bryco]

fixo, I didn't figure out why yours didn't work but you are sorting all the points which is not necessary.
rogue was finding an average, not always correct.
Atook took the correct and simple approach.
CadRover 

That will get you the midpoints of each ent in the selection set; it still does not seem to address what I was originally hoping for.

Perhaps if you try it, it may even work.

[Atook]

Except that my code had bugs in it that Bryco corrected by switching the last two '<'s with '>'s.

I think you've got everything you need, you just need to piece it together..

If not, then what exactly is the difference between what you're expecting and what's happening? You posted earlier a comment about viewing the mid-point in the immediate window. Put something together from what we've got, and a selectionset where you know the mid-point, and see where the difference is.

The problem may be in the mid-point calculation (there are multiple yet different 'correct' ways) or in your execution after you find the point and are manipulating the selectionset. We can help with either.

It's late and the beer was flowing tonight, I hope I make sense.

[CadRover]

Perhaps if you try it, it may even work.

Bryco,

I appreciate your help but I'm not sure why you are assuming I did not try it?
Did you see my last post? I did try your suggested code.

I placed the code in precisely how I thought it needed to be and it still did not work.
I just realized that I missed the > as well.

Again, here is my code in its entirety; I am not sure where it is wrong.

I am trying to grab every thing in the entire sset and move it from the midpnt
If that is what the code that you suggested is doing, then I apologize because I missed something.

I think that Tipo's code did not have values assigned to some variables.
I stepped through hit and some variables were coming up as 0.

Thanks again
CADR

Code: [Select]

Sub MovefromMidPntofEntBB()
 Dim objEnt As AcadEntity
 Dim objSS As AcadSelectionSet
 Dim varMinBound As Variant
 Dim varMaxBound As Variant
 Dim minX As Double, maxX As Double
 Dim minY As Double, maxY As Double

 On Error Resume Next
 ThisDrawing.SelectionSets.Item("GetEnt").Delete

 Set objSS = ThisDrawing.SelectionSets.Add("GetEnt")
 objSS.SelectOnScreen

 Set objEnt = objSS(0)
  objEnt.GetBoundingBox varMinBound, varMaxBound
  minX = varMinBound(0): maxX = varMaxBound(0)
  minY = varMinBound(1): maxY = varMaxBound(1)

  For Each objEnt In objSS
   objEnt.GetBoundingBox varMinBound, varMaxBound
   If varMinBound(0) < minX Then minX = varMinBound(0)
   If varMinBound(1) < minY Then minY = varMinBound(1)
   If varMaxBound(0) > maxX Then maxX = varMaxBound(0)
   If varMaxBound(1) > maxY Then maxY = varMaxBound(1)
  Next objEnt
   
  Dim cpt(2) As Double
  cpt(0) = (minX + maxX) / 2
  cpt(1) = (minY + maxY) / 2
  Midpnt = cpt
   
  Dim MoveTopnt As Variant
  MoveTopnt = ThisDrawing.Utility.GetPoint(, "Select Destination Point: ")
  objSS.Move Midpnt, MoveTopnt
   
  objSS.Delete
 'Debug.Print "varMinBound(0) = " & varMinBound(0) & " / " & "varMaxBound(1) = " & varMaxBound(1)
 'Debug.Print "minX = " & minX & " / " & "maxX = " & maxX
End Sub


[CadRover]

Atook

I absolutely did try for quite a while with the code that you and Byrco both supplied.
It wasn't hard to piece something together that works because I already had code that will do each entity one at a time.
The problem I am having still, in my efforts was that I can not get the midpnt of the entire sset and move it into place.
In theory, from the get go, I think I had the right idea; unfortunately I did not get the result I needed after about an hour of trying.

May be I will try again tomorrow.

I agree with you, it is late and I am beat

Thanks for the help!

CADR

[CadRover]

I'm sure if I play around with it more, I can eventually get the result that I am looking for

It is not that important, nothing pressing

Thanks!
CADR

[Bryco]

Well I was hoping you would test it with the addition of a point and then check to see if the point was correct.
As that is the nature of testing code, one thing at a time.
Here you have checked the code by adding
1) an On error resume confusion next statement
2) objSS.Move Midpnt, MoveTopnt

Well there isn't a move method for a selectionset,  and turning off the error handler would show you that.
You must cycle through the set
'objSS.Move cpt, MoveTopnt
   For Each objEnt In objSS
   objEnt.Move cpt, MoveTopnt
   Next

In fact the post

Yes, Fixo
That will get you the midpoints of each ent in the selection set; it still does not seem to address what I was originally hoping for.
I'm not even sure it can be done.

Told me you hadn't tested the code

[CadRover]

Hi Bryco,

WOW, I can see that I am not the only one burning the midnight oil

Yes, I see your point; I use the on error resume next as easy way way to get past the key not found "if" The Selection Set doesn't exists, if it does, I delete it, otherwise move on to adding it.
Probably not the best way to handle it but it seems to work for me.
You raise a good point though; that is, that if there is another error, it may get over looked,

I am generally pretty good at running through code with the locals.
Even more so lately

When I remarked about the midpoints, I saw that you did the division, that is how I surmised that you had gotten the midpoints

You see, I think you/we identified the problem I was having; that is that there is no move method for ssets, therefore, I was trying to be creative. The whole time I was seeing that the points were getting into the variables as I was stepping through the code in the locals, but it was the move method that I was fixated on.

OK, I see....
I do loop through ssets by entity but from what you are saying, it seems that each entity will be moved at once still once we have looped through each ent and it is assigned to the sset; is that correct?
Or will they be moved one at a time?
Let me take a look.
Thanks for the patience.

Bry,
Incidentally, in the meantime, I recalled that I had some older code around.
I this this method would work also? Or, a variation of?
It looks even simpler then what we have done.
After stepping through the code, it does look like all variables are being properly set, again, it was the move method I was struggling with.

Here, do you mind taking a look?
Tell me what you think.
The variables will be different because this is older code that I pieced together but the same idea

I Will also try the code and method that you just posted

Thank you

CADR

Code: [Select]

Sub LastTry()
 Dim Ent As AcadEntity
 Dim Sset As AcadSelectionSet
 Dim llpnt As Variant 'lower left point
 Dim urpnt As Variant 'upper right point
 Dim Midpnt(0 To 2) As Double
 
 With ThisDrawing.Utility
  llpnt = .GetPoint(, vbCrLf & "Select Lower Left Point: ")
  urpnt = .GetCorner(llpnt, vbCrLf & "Select Upper Right Point: ")
 End With
 
 On Error Resume Next 'I know, I know :)
 ThisDrawing.SelectionSets.Item("GetEnts").Delete
 
 Set Sset = ThisDrawing.SelectionSets.Add("GetEnts")
 Sset.Select acSelectionSetCrossing, llpnt, urpnt
 
 Midpnt(0) = (llpnt(0) + urpnt(0)) / 2
 Midpnt(1) = (llpnt(1) + urpnt(1)) / 2
 
 'Bry, i will need that loop here, most likely

  Dim MoveTopnt As Variant
  MoveTopnt = ThisDrawing.Utility.GetPoint(, "Select Destination Point: ")

  For Each Ent In Sset
   Ent.Move Midpnt, MoveTopnt
  Next
 End Sub


[CadRover]

Hey Bry
I just tried the code that I just posted with doing the loop the way you suggested; it looks like it worked perfectly,
I need to make sure that the absolute center is being grabbed but I think this did it.
I am not using thr bounding box method at all, as you have probably noticed.

This may actually be the way to go

Please give it a try

Thanks!

CR

[CadRover]

Holy S**T!
It looks like it was working perfectly

CR

[Atook]

Holy S**T!
It looks like it was working perfectly..

Don't you love it when that happens!

Congrats, I'm glad we could help.

[CadRover]

Don't you love it when that happens!

Yes,
I do ATook, especially when it happens when you didn't expect it to.
Next, time, I will rather get it at 8 at night, instead of 4am
Nonetheless, it seems to working well now.
Yes, thank you guys for all the assistance.

CR

[CadRover]

This midnight coding has to end..
It has to enddddddddddddddd

[CadRover]

Hey guys, this is certainly not rocket science by any stretch but with code like the above, I sometimes like to add something like this to the end, in the case that a user decides that they don't want to make that change.

Code: [Select]

ThisDrawing.Regen acActiveViewport
 
 If MsgBox("Are you sure that you want to move these entities?", vbYesNo) = vbYes Then
  Exit Sub
 Else
  ThisDrawing.SendCommand "undo" & vbCr & "1" & vbCr
  ThisDrawing.Regen acActiveViewport
 End If

I placed it right below the For Each Loop and before The End Sub

CR