Author Topic: Match Scale Properties  (Read 3784 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
Match Scale Properties
« on: September 16, 2004, 07:16:57 PM »
Hello

I was trying very hard to develop a VBA macro that will allow me to choose one block and apply the scale of that block to scale another block

I would want it to work similar to Match properties but only to match scale properties. The best way I can describe what I want would be having an automated routine that does what you could acheive by using scale reference.

I believe the answer lies in The x, y and z scale factor methods in VBA but I had no luck.

Can anyone help?

Thanks

Mark

Ron Heigh

  • Guest
Match Scale Properties
« Reply #1 on: September 16, 2004, 07:29:38 PM »
Are these items uniformly scaled?

ML

  • Guest
Match Scale Properties
« Reply #2 on: September 16, 2004, 07:37:07 PM »
I would say yes Ron

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16727
  • Superior Stupidity at its best
Match Scale Properties
« Reply #3 on: September 16, 2004, 09:08:12 PM »
The truth is that it should make no difference if the block original block is uniformly scaled. The only thing I can imagine is that you might not want to match the negative scaling of a block because it will cause a mirrored block to "unmirror"

This routine can be characterized by the following pseudocode
Code: [Select]

Select single block reference object
extract x y and z scales
convert scales to absolute values
Select blocks to apply scale to...
apply absolute value scale to blocks to be matched, taking care to make the scale positive and/or negative where required.


Given that information, we can do the following...
See if you can find where the program does what is specified in the pseudo code above.

Code: [Select]

Sub MatchBlockScale()
Dim XScale As Double
Dim YScale As Double
Dim ZScale As Double
Dim OXScale As Double
Dim OYScale As Double
Dim OZScale As Double
Dim ACBlockRef As AcadBlockReference
Dim SSet As AcadSelectionSet
Dim Code(0) As Integer
Dim Data(0) As Variant
Dim GCode As Variant
Dim GData As Variant
Dim X As Integer

Code(0) = 0
Data(0) = "INSERT"

GCode = Code
GData = Data

Set SSet = ThisDrawing.SelectionSets.Add("MatchScale")
While SSet.Count <> 1
 SSet.SelectAtPoint ThisDrawing.Utility.GetPoint(, "Select block reference"), GCode, GData
Wend
 Set ACBlockRef = SSet.Item(0)
 XScale = Abs(ACBlockRef.XScaleFactor)
 YScale = Abs(ACBlockRef.YScaleFactor)
 ZScale = Abs(ACBlockRef.ZScaleFactor)
 SSet.Clear
 SSet.SelectOnScreen GCode, GData
 For X = 0 To SSet.Count - 1
  Set ACBlockRef = SSet.Item(X)
  OXScale = ACBlockRef.XScaleFactor
  OYScale = ACBlockRef.YScaleFactor
  OZScale = ACBlockRef.ZScaleFactor
  If OXScale > 0 Then
   ACBlockRef.XScaleFactor = XScale
  Else
   ACBlockRef.XScaleFactor = 0 - XScale
  End If
  If OYScale > 0 Then
   ACBlockRef.YScaleFactor = YScale
  Else
   ACBlockRef.YScaleFactor = 0 - YScale
  End If
  If OZScale > 0 Then
   ACBlockRef.ZScaleFactor = ZScale
  Else
   ACBlockRef.ZScaleFactor = 0 - ZScale
  End If
 Next X
 SSet.Delete
End Sub
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

ML

  • Guest
Match Scale Properties
« Reply #4 on: September 16, 2004, 11:06:09 PM »
Cool! Thanks Keith, I really appreciate that. I will give it a try tomorrow and let you know how it works

Thanks

Mark

ML

  • Guest
Match Scale Properties
« Reply #5 on: September 17, 2004, 07:44:26 PM »
Keith

You are the man!

I added an errorhandler at the end to handle the Sset already exists message and renamed the module to MatchScaleProperties but otherwise it works perfect

I like the way you did it, if I were to use scale reference to do the same thing, all blocks would scale to a specified base point but the way you did it, all blocks scale in place which is exactly what I wanted.

Thank you again

Mark

ML

  • Guest
Match Scale Properties
« Reply #6 on: September 17, 2004, 09:53:49 PM »
Keith

Here is how i tweaked it, hope you don't mind?
Note: The Errorhandler

Mark


Code: [Select]
Sub MatchScaleProperties()

On Error GoTo Errorhandler

Dim XScale As Double
Dim YScale As Double
Dim ZScale As Double
Dim OXScale As Double
Dim OYScale As Double
Dim OZScale As Double
Dim ACBlockRef As AcadBlockReference
Dim SSet As AcadSelectionSet
Dim Code(0) As Integer
Dim Data(0) As Variant
Dim GCode As Variant
Dim GData As Variant
Dim X As Integer

Code(0) = 0
Data(0) = "INSERT"

GCode = Code
GData = Data

Set SSet = ThisDrawing.SelectionSets.Add("MatchScale")
While SSet.Count <> 1
 SSet.SelectAtPoint ThisDrawing.Utility.GetPoint(, "Select block reference"), GCode, GData
Wend
 Set ACBlockRef = SSet.Item(0)
 XScale = Abs(ACBlockRef.XScaleFactor)
 YScale = Abs(ACBlockRef.YScaleFactor)
 ZScale = Abs(ACBlockRef.ZScaleFactor)
 SSet.Clear
 SSet.SelectOnScreen GCode, GData
 For X = 0 To SSet.Count - 1
  Set ACBlockRef = SSet.Item(X)
  OXScale = ACBlockRef.XScaleFactor
  OYScale = ACBlockRef.YScaleFactor
  OZScale = ACBlockRef.ZScaleFactor
  If OXScale > 0 Then
   ACBlockRef.XScaleFactor = XScale
  Else
   ACBlockRef.XScaleFactor = 0 - XScale
  End If
  If OYScale > 0 Then
   ACBlockRef.YScaleFactor = YScale
  Else
   ACBlockRef.YScaleFactor = 0 - YScale
  End If
  If OZScale > 0 Then
   ACBlockRef.ZScaleFactor = ZScale
  Else
   ACBlockRef.ZScaleFactor = 0 - ZScale
  End If
 Next X
 SSet.Delete
 
GoTo Done

Errorhandler:
 
If ThisDrawing.SelectionSets.Count > 0 Then
ThisDrawing.SelectionSets.Item("MatchScale").Delete
Debug.Print "Delete"
End If
 
Done:
 
End Sub

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16727
  • Superior Stupidity at its best
Match Scale Properties
« Reply #7 on: September 18, 2004, 10:09:14 PM »
Cool... I tol' ya you were gettin' better....
Of course I failed to add in error handling and in my haste forgot to tell you that it needed to be done.....
Good call...
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Anonymous

  • Guest
Match Scale Properties
« Reply #8 on: September 18, 2004, 10:30:46 PM »
Well, thank you sir!

Of course I am getting better because I have one of the best around to learn from. The Module kicks a_s!

Thanks again


Mark

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16727
  • Superior Stupidity at its best
Match Scale Properties
« Reply #9 on: September 18, 2004, 10:35:46 PM »
Hey Mark... hit the "Keep me logged in" button next time... it'll make life a little better for us all ...
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

ML

  • Guest
Match Scale Properties
« Reply #10 on: September 21, 2004, 09:20:32 PM »
Hey Keith

Why do I need to stay logged in? Why will it make it easier for everyone? So they know it is me posting?

I hope other people can benefit from this code, it kicks a*s

Mark

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16727
  • Superior Stupidity at its best
Match Scale Properties
« Reply #11 on: September 21, 2004, 10:33:33 PM »
It makes it a little easier knowing who we are talking to.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Anonymous

  • Guest
Match Scale Properties
« Reply #12 on: September 22, 2004, 06:25:38 AM »
I see, well, I will be the guy that asks a lot of questions, particularly VBA questions     :)

ML

  • Guest
Match Scale Properties
« Reply #13 on: September 22, 2004, 06:27:52 AM »
OK, Sorry bout that Keith, I am automatically logged in now.

 :P