Go
New
Find
Notify
Tools
Reply
  
5-star Rating (1 Vote) Rate It!  Login/Join 
Junior Member
Posted
I have written my first script. The purpose of it is to automatically shift and resize a new scene so that it is manageable within 3D Canvas. It also supports autoscaling. I wrote it because a number of models that I have imported from 3DS and other formats end up being much too large (scale-wise) for 3D Canvas.

The script also does not affect any object/group hierarchy. This was a big problem before because the only way to "Select-all" before a scale operation was to create a root/dummy node, but that affected the hierarchy and group positions.

Please let me know if it works for you or if you find any problems / have suggestions...

Is there a way I can "upload" this script, or do I just leave it in this message? (it looks like some of the formatting wasn't preserved)

Enjoy!  ;D
Cal.

Language = VBScript

'*********************************************************************************
' Purpose: Auto-sets a scene
' Author:  Calvin Hass
'
'          This script is used to shift and resize a scene automatically
'          so that it fits within the 3D Canvas environment appropriately.
'          The shift of the origin recenters all of the objects to a new
'          co-ordinate. The scaling can either be through manual means,
'          or through an autosize. The autosize resizes all objects in the
'          scene proportionately so that the maximum size in any one axis
'          is equal to the user defined extent (eg. 5).
'*********************************************************************************

Option Explicit          'require variable declarations

Sub Main (CanvasApp)

    Dim Scene
    Dim NewX
    Dim NewY
    Dim NewZ
    Dim ScaleX
    Dim ScaleY
    Dim ScaleZ

    Dim Reply
    Dim OK             ' Continue with operation?
    Dim MaxExtentStr
    Dim MaxExtent
    Dim NewXStr
    Dim NewYStr
    Dim NewZStr
    Dim ScaleXStr
    Dim ScaleYStr
    Dim ScaleZStr

    Dim MinX           'Minimum X
    Dim MinY           'Minimum Y
    Dim MinZ           'Minimum Z
    Dim MaxX           'Maximum X
    Dim MaxY           'Maximum Y
    Dim MaxZ           'Maximum Z
    Dim SizeX          'Size X
    Dim SizeY          'Size Y
    Dim SizeZ          'Size Z

    'get the scene
    Set Scene = CanvasApp.GetActiveScene

    OK = 1

    'Ask for the new origin for the scene
    'All objects will be moved to a center around this origin
    NewXStr = InputBox("New Origin X?",,"5")
    If NewXStr <> "" Then        
      'translate the entered string into a numeric value
      On Error Resume Next
      NewX = CSng(NewXStr)
      Err.Clear
      On Error Goto 0
    else
      ok = 0
    end if

    if OK = 1 then
      NewYStr = InputBox("New Origin Y?",,"0")
      If NewYStr <> "" Then        
        'translate the entered string into a numeric value
        On Error Resume Next
        NewY = CSng(NewYStr)
        Err.Clear
        On Error Goto 0
      else
        ok = 0
      end if
    end if

    if OK = 1 then
      NewZStr = InputBox("New Origin Z?",,"5")
      If NewZStr <> "" Then        
        'translate the entered string into a numeric value
        On Error Resume Next
        NewZ = CSng(NewZStr)
        Err.Clear
        On Error Goto 0
      else
        ok = 0
      end if
    end if


    'Perform autoscaling
    Scene.GetBoundingBox MinX, MinY, MinZ, MaxX, MaxY, MaxZ
    SizeX = MaxX - MinX
    SizeY = MaxY - MinY
    SizeZ = MaxZ - MinZ

    if OK = 1 then

      Reply = MsgBox("Autosize the scene?", 3)
      If Reply = vbYes Then

        MaxExtentStr = InputBox("Maximum extent?",,"5")

        'if they entered anything
        If MaxExtentStr <> "" Then        
          'translate the entered string into a numeric value
          On Error Resume Next
          MaxExtent = CSng(MaxExtentStr)
          Err.Clear
          On Error Goto 0
        else
          OK = 0
        end if


        'Calculate the autosize
        if (SizeX >= SizeY) and (SizeX >= SizeZ) then
          ScaleX = MaxExtent / SizeX
          ScaleY = ScaleX
          ScaleZ = ScaleX
        elseif (SizeY >= SizeX) and (SizeY >= SizeZ) then
          ScaleY = MaxExtent / SizeY
          ScaleX = ScaleY
          ScaleZ = ScaleY
        elseif (SizeZ >= SizeX) and (SizeZ >= SizeY) then
          ScaleZ = MaxExtent / SizeZ
          ScaleX = ScaleZ
          ScaleY = ScaleZ
        end if

      Elseif Reply = vbNo then
        ' No autosize -- instead ask for specific scaling 

        if OK = 1 then
          ScaleXStr = InputBox("ScaleX?",,"1.00")
          If ScaleXStr <> "" Then        
            'translate the entered string into a numeric value
            On Error Resume Next
            ScaleX = CSng(ScaleXStr)
            Err.Clear
            On Error Goto 0
          else
            OK = 0
          end if
        end if
        if OK = 1 then
          ScaleYStr = InputBox("ScaleY?",,"1.00")
          If ScaleYStr <> "" Then        
            'translate the entered string into a numeric value
            On Error Resume Next
            ScaleY = CSng(ScaleYStr)
            Err.Clear
            On Error Goto 0
          else
            OK = 0
          end if
        end if
        if OK = 1 then
          ScaleZStr = InputBox("ScaleZ?",,"1.00")
          If ScaleZStr <> "" Then        
            'translate the entered string into a numeric value
            On Error Resume Next
            ScaleZ = CSng(ScaleZStr)
            Err.Clear
            On Error Goto 0
          else
            OK = 0
          end if
        end if

      Else
        OK = 0
      End if ' reply

    End if ' ok

    ' Perform the shift and scale
    if OK = 1 then
      AllShiftScale Scene, NewX, NewY, NewZ, ScaleX, ScaleY, ScaleZ
    end if

End Sub


Sub AllShiftScale (Scene, ShiftX, ShiftY, ShiftZ, ScaleX, ScaleY, ScaleZ)

    Dim Object
    Dim Group
    Dim PointCount
    Dim PointIndex
    Dim PointX
    Dim PointY
    Dim PointZ
    Dim AllObjectCount
    Dim ObjectIndex

    Dim MinX           'Minimum X
    Dim MinY           'Minimum Y
    Dim MinZ           'Minimum Z
    Dim MaxX           'Maximum X
    Dim MaxY           'Maximum Y
    Dim MaxZ           'Maximum Z
    Dim MidX           'Middle X
    Dim MidY           'Middle Y
    Dim MidZ           'Middle Z

    'Determine center of scene
    Scene.GetBoundingBox MinX, MinY, MinZ, MaxX, MaxY, MaxZ

    MidX = (MaxX - MinX)/2 + MinX
    MidY = (MaxY - MinY)/2 + MinY
    MidZ = (MaxZ - MinZ)/2 + MinZ

    'get the active object count
    AllObjectCount = Scene.GetObjectCount

    'run through the objects one at a time
    For ObjectIndex = 0 to AllObjectCount - 1

      'get the indexed object
      Set Object = Scene.GetObject(ObjectIndex)

      Set Group = Object.GetParentGroup

      'Get the world position
      Group.GetPosition Nothing, PointX, PointY, PointZ

      'shift the point
      PointX = PointX - MidX
      PointY = PointY - MidY
      PointZ = PointZ - MidZ

      'set the point
      Group.SetPosition Nothing, Time, PointX, PointY, PointZ

      'get the number of points in the object
      PointCount = Object.GetPointCount
    
      'Run through the points shifting them
      For PointIndex = 0 to PointCount - 1

        'get the point
        Object.GetPoint PointIndex, PointX, PointY, PointZ
    
        'shift the point
        PointX = PointX * ScaleX
        PointY = PointY * ScaleY
        PointZ = PointZ * ScaleZ

        'set the point
        Object.SetPoint PointIndex, PointX, PointY, PointZ
      Next

      ' Now rescale the group's position
      Group.GetPosition Nothing, PointX, PointY, PointZ
      PointX = PointX * ScaleX + ShiftX
      PointY = PointY * ScaleY + ShiftY
      PointZ = PointZ * ScaleZ + ShiftZ
      Group.SetPosition Nothing, Time, PointX, PointY, PointZ
 
      'finally write a Script operation layer to save the change
      Object.WriteScriptOperationLayer

    Next 'all objects

End Sub


This message has been edited. Last edited by: calvin,
 
Posts: 66 | Registered: Fri November 07 2003Reply With QuoteEdit or Delete MessageReport This Post
KB
Member
Picture of KB
Posted Hide Post
Calvin,
 This is great! ;D Thank you.  8) Just tried it on a over sized dog I wanted to work on. No problem, thanks again.

KB
 
Posts: 540 | Location: Carnelian Bay, Ca. | Registered: Fri November 07 2003Reply With QuoteEdit or Delete MessageReport This Post
Member
Posted Hide Post
good work.  I'll try it soon.
George
 
Posts: 190 | Registered: Fri November 07 2003Reply With QuoteEdit or Delete MessageReport This Post
Junior Member
Posted Hide Post
KB -- Glad it worked for you. I found many of my 3DS imports ended up having dimensions in the tens of thousands of units! Thus my other requests for non-linear zoom, zoom-extents, etc.

C'ya,
Cal.
 
Posts: 66 | Registered: Fri November 07 2003Reply With QuoteEdit or Delete MessageReport This Post
Member
Posted Hide Post
I'm liking your non-linear zoom idea. I have that problem myself at times. I'm not certain why I haven't implemented it before. I'm hoping it won't be a big issue and I can implement it for 6.0a.

Richard
 
Posts: 2378 | Registered: Fri November 07 2003Reply With QuoteEdit or Delete MessageReport This Post
Junior Member
Posted Hide Post
Richard -- that's great...

I think a real non-invasive approach might be to have a mode of operation (via preferences) that dictates the zoom style (linear vs non-linear/accelerating). Better yet would be a modifier key for the zoom mode, but I'm not sure if they are all already accounted for.

One of the biggest issues with a non-linear zoom is allowing for hysteresis and an appropriate sensitivity.

In non-linear zoom mode, I'd recommend a region (central 10%) that is the hysteresis dead-point with no change in zoom level.

Outside that region, the mouseDown co-ordinate's distance from the edge of the dead-region is simply scaled by the sensitivity to provide a zoom delta.

If people were to use the non-linear zoom often in modelling, then a low sensitivity value might be appropriate for them. While others, who are importing large-scale models, a high sensitivity might be best.

With a standard 800x600 screen resolution, users can get a scale change-rate range in the order of 1x-270x ((600-0.1*600)/2). This might be enough to arbitrarily select a sensitivity constant that will work for almost everyone without any need for configuration. Otherwise, a "sensitivity" user configuration parameter might be nice to have in the "Properties".

Cal.
 
Posts: 66 | Registered: Fri November 07 2003Reply With QuoteEdit or Delete MessageReport This Post
Member
Picture of Amabilis Support
Posted Hide Post
3D Canvas now includes this function in it's import options. This is however still a really useful script.
 
Posts: 1412 | Registered: Thu November 06 2003Reply With QuoteEdit or Delete MessageReport This Post
 Previous Topic | Next Topic powered by eve community  
 


© Amabilis Software 2003-2007