### Author Topic: Absolute Center of Sset  (Read 8444 times)

0 Members and 2 Guests are viewing this topic.

#### fixo

• Guest
##### Re: Absolute Center of Sset
« Reply #15 on: July 09, 2008, 01:06:31 AM »
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

• Guest
##### Re: Absolute Center of Sset
« Reply #16 on: July 09, 2008, 01:14:47 AM »

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

• Water Moccasin
• Posts: 1883
##### Re: Absolute Center of Sset
« Reply #17 on: July 09, 2008, 01:30:34 AM »
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
Quote
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

• Swamp Rat
• Posts: 1031
• AKA Tim
##### Re: Absolute Center of Sset
« Reply #18 on: July 09, 2008, 01:56:11 AM »
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.
« Last Edit: July 09, 2008, 02:02:58 AM by Atook »

#### CadRover

• Guest
##### Re: Absolute Center of Sset
« Reply #19 on: July 09, 2008, 03:31:34 AM »

Quote
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 = " & maxXEnd Sub`

#### CadRover

• Guest
##### Re: Absolute Center of Sset
« Reply #20 on: July 09, 2008, 03:40:21 AM »

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

• Guest
##### Re: Absolute Center of Sset
« Reply #21 on: July 09, 2008, 03:51:52 AM »

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

• Water Moccasin
• Posts: 1883
##### Re: Absolute Center of Sset
« Reply #22 on: July 09, 2008, 05:08:30 AM »
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
Quote
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

• Guest
##### Re: Absolute Center of Sset
« Reply #23 on: July 09, 2008, 05:35:31 AM »

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

• Guest
##### Re: Absolute Center of Sset
« Reply #24 on: July 09, 2008, 05:39:31 AM »

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

• Guest
##### Re: Absolute Center of Sset
« Reply #25 on: July 09, 2008, 05:52:21 AM »

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

CR

#### Atook

• Swamp Rat
• Posts: 1031
• AKA Tim
##### Re: Absolute Center of Sset
« Reply #26 on: July 09, 2008, 10:26:10 AM »
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

• Guest
##### Re: Absolute Center of Sset
« Reply #27 on: July 09, 2008, 01:40:56 PM »
Quote
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

• Guest
##### Re: Absolute Center of Sset
« Reply #28 on: July 09, 2008, 01:41:39 PM »

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

#### CadRover

• Guest
##### Re: Absolute Center of Sset
« Reply #29 on: July 09, 2008, 03:34:10 PM »
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