TurboCAD Forums

The Ultimate Resource for TurboCAD Knowledge

Register
 
When replying to a specific statement be sure to quote the previous post.

BCI Sun Tool Mod
Read 1981 times
* March 20, 2014, 09:48:56 AM
I am using the bci sun tool, and would like to add a yellow sphere as an object that represents the sun, I have the script that moves the light, but do't know how to mod it to move a sphere. I want to create a new script based on the same, only instead of moving the light, I want it to move the sphere which will represent the sun.

Any help appreciated!.

Here is the script that moves the light to cast shadows.

SpMoveSun.txt     The command script file for moving a light that represents the sun.

' From(0) To(-) Light\SPMoveSun(FFFF) CenterNorth(ActorName) Latitude(0) DayOfYear(1) TimeOfDay(12.0)

function RunCustomCommand(Gr,commandStr,nCount, StAniEditor)
Dim tCentre, tLatitude, tDay, tTime, retVal, xStepCount, xStepNum
Dim tNorth
retVal = GetErrorString(ERR_COMMANDSYNTAXERROR, commandStr)
Dim tP1, tP2

if nCount <> 6 then exit function

   ' For some reason
   '   call GetParameterN(commandStr,1, tCentre)
   ' fails, so for the meantime use a workaround

      tP1 = InStr(commandStr, "SPMoveSun ") + 10
      tP2 = Instr(tP1, commandStr, " ")
      tCentre = Mid(commandStr, tP1, tP2-tP1)
      'Alert tCentre
      set tNorth = GetActorFromName(tCentre)
      tNorth.Vertices.UseWorldCS = true
      if (tNorth.Vertices.Count < 2) then
         Alert "CentreNorth must have at least two vertices"
         exit function
      end if
      if (tNorth.Vertices(0).Z > 0.00001 Or tNorth.Vertices(1).Z > 0.00001) then
         Alert "CentreNorth Actor must be on the World workplane"
         exit function
      end if
      tNorth.Vertices.UseWorldCS = false

   call GetParameterN(commandStr,2, tLatitude)   ' Decimal latitude (South negative)
   call GetParameterN(commandStr,3, tDay)      ' Day of year where 1 Jan = 1
   call GetParameterN(commandStr,4, tTime)      ' 24hr local Time, does not allow for timezone/longitude discrepancies


if (bCheckScenarioMode = false and (StepNum >= From1) and (StepNum <= To1))  then


   ' Calculate dXYZ from LDT
   xStepCount = To1 - From1
   xStepNum = StepNum - From1
   'Calculate the apparent position of the sun at given position & time
   'Puts values in appropriate text boxes for Preview & Create to use
   'Not perfect, but close. Read ref below for more info.

   'Acknowledgement:
       'This is based on a program written by Dave Rusin, [email protected]
       'Read all about it at http://www.math.niu.edu/~rusin/uses-math/position.sun/

   
        Dim Alpha, Theta, Psi, Noon, tDawn, tDusk
   dim IndTo, xStart, xFinish, AutoInc
   AutoInc = 0.0

       'compute apparent solar position:
       if TypeName(tDay) = "String" then
         if UCase(tDay) = "AUTO" then
            if tLatitude > 0 then
               tDay = 170.3125 + xStepNum / xStepCount * 365.25
            else
               tDay =  -12.3125 + xStepNum / xStepCount * 365.25
            end if
            AutoInc = 365.25/xStepCount
         elseif left(UCase(tDay),4) = "AUTO" then
            IndTo = Instr(5, UCase(tDay), " TO ")
            xStart = trim(mid(tDay, 5, IndTo - 5))
            xFinish = trim(mid(tDay, IndTo + 3))
         
            tDay = xStart + xStepNum / xStepCount * (xFinish-xStart)
            AutoInc  = (xFinish-xStart)/xStepCount

         end if
      end if   
      

       if IsDate(tDay) then
         tDay = DatePart("y", tDay)
       else
          tDay = tDay
       end if

      Dim DescString
      DescString = ""
      DescString = DescString & "Latitude = " & tLatitude
      DescString = DescString & vbCrLf & "Day = " & tDay
      DescString = DescString & vbCrLf & "DayAutoInc = " & AutoInc

      tDay = tDay - 79  'Days since March equinox (approx)



       Alpha = 23.45 * Pi / 180    'Earth slant
       Theta = tLatitude * Pi / 180
       Psi = tDay * 2 * Pi / 365.25
       Noon = Atn(Tan(Psi) * Cos(Alpha))
       If Cos(Theta) * Cos(Psi) * Cos(Noon) < 0 Then Noon = Noon + Pi
      
       Dim tNewTime, A, B, C, F, X
   
      A=cos(Theta)*cos(Psi)
      B=cos(Alpha)*cos(Theta)*sin(Psi)
      C=sin(Alpha)*sin(Theta)*sin(Psi)
      F=sqr(A*A+B*B)
      if F=0 then
         tDawn = 0
         tDusk = 24
      else
         A=A/F
         B=B/F
         C=-C/F

         if B=0 then
            X=A*Pi/2
         else
            X=atn(A/B)
            if B*cos(X)<0 then X=X+Pi
         end if
         
         if abs(C)>1 then
            tDawn = 0
            tDusk = 24
         elseif abs(C)=1 then
            tDawn=((C*Pi/2-X-Noon)*12/Pi+12)
            tDusk=((C*Pi/2-X-Noon)*12/Pi+12)
         else
            tDawn=((atn(C/sqr(1-C*C))-X-Noon)*12/Pi+12)
            tDusk=((Pi-atn(C/sqr(1-C*C))-X-Noon)*12/Pi+12)
            if tDawn > tDusk then
               X=tDawn
               tDawn = tDusk
               tDusk=X
            End If
         end if
      end if

      DescString = DescString & vbCrLf & "Dawn = " & tDawn
      DescString = DescString & vbCrLf & "Dusk = " & tDusk


      AutoInc = 0.0

       if TypeName(tTime) = "String" then
         if UCase(tTime) = "AUTO" then
            tTime = tDawn + xStepNum/xStepCount*(tDusk-tDawn)
            AutoInc  = (tDusk-tDawn)/xStepCount
         elseif left(UCase(tTime),4) = "AUTO" then
            IndTo = Instr(5, UCase(tTime), " TO ")
            xStart = trim(mid(tTime, 5, IndTo - 5))
            xFinish = trim(mid(tTime, IndTo + 3))
            tTime = xStart + xStepNum / xStepCount * (xFinish-xStart)
            AutoInc  = (xFinish-xStart)/xStepCount
         end if
       End if


      DescString = DescString & vbCrLf & "Time = " & tTime
      DescString = DescString & vbCrLf & "TimeAutoInc = " & AutoInc

       'glossing over cases where phi, psi, or theta = +- pi/2
       Phi = Noon + (tTime - 12) * 2 * Pi / 24

'Alert 4
   
   'First Calculate the Earth angles
   Dim dX, dY, dZ, dL, dA
       dX = Round(-Cos(Psi) * Sin(Phi) + Cos(Alpha) * Sin(Psi) * Cos(Phi), 5)
       dY = Round(-Sin(Theta) * Cos(Psi) * Cos(Phi) - Cos(Alpha) * Sin(Theta) * Sin(Psi) * Sin(Phi) + Sin(Alpha) * Cos(Theta) * Sin(Psi), 5)
       dZ = Round(Cos(Theta) * Cos(Psi) * Cos(Phi) + Cos(Alpha) * Cos(Theta) * Sin(Psi) * Sin(Phi) + Sin(Alpha) * Sin(Theta) * Sin(Psi), 5)
       dL = Sqr(dX^2 + dY^2)

       If dX = 0 Then   'North/South
           dA = (Sgn(dY) - 1) * Pi / 2
       ElseIf dY = 0 Then   'East/West
           dA = Sgn(dX) * Pi / 2
       ElseIf dY > 0 Then
           dA = Atn(dX / dY)
       Else
           dA = Atn(dX / dY) + Pi
       End If

       'XYZ Vector is normalised to Length = 1.0

   'Now overlay the north vector

   Dim nX, nY, nL, nA
       tNorth.Vertices.UseWorldCS = true
       nX = tNorth.Vertices(1).X - tNorth.Vertices(0).X
       nY = tNorth.Vertices(1).Y - tNorth.Vertices(0).Y
       tNorth.Vertices.UseWorldCS = false
       nL = Sqr(nX^2 + nY^2)

       If nX = 0 Then   'North/South
           nA = (Sgn(nY) - 1) * Pi / 2
       ElseIf nY = 0 Then   'East/West
           nA = Sgn(nX) * Pi / 2
       ElseIf nY > 0 Then
           nA = Atn(nX / nY)
       Else
           nA = Atn(nX / nY) + Pi
       End If
       'nA = nA - Pi/2

       dX = dL * Sin(dA + nA)
       dY = dL * Cos(dA + nA)

       ' XYZ Vector is still normalised to Length = 0
   
   'Apply to graphic
   Dim tLength
   if Gr.Type = "TCLight" then
      Gr.Vertices.UseWorldCS = true
      tNorth.Vertices.UseWorldCS = true
      tLength = Sqr((Gr.Vertices(0).X - tNorth.Vertices(0).X)^2 + (Gr.Vertices(0).Y - tNorth.Vertices(0).Y)^2 + (Gr.Vertices(0).Z - tNorth.Vertices(0).Z)^2)

      Gr.Vertices(0).X = tNorth.Vertices(0).X + dX * tLength
      Gr.Vertices(0).Y = tNorth.Vertices(0).Y + dY * tLength
      Gr.Vertices(0).Z = tNorth.Vertices(0).Z + dZ * tLength

      Gr.Vertices(1).X = tNorth.Vertices(0).X
      Gr.Vertices(1).Y = tNorth.Vertices(0).Y
      Gr.Vertices(1).Z = tNorth.Vertices(0).Z

      Gr.Vertices.UseWorldCS = false
      tNorth.Vertices.UseWorldCS = false
      Gr.Properties("Info") = DescString

   else

'      tNorth.Vertices.UseWorldCS = true
'      Gr.Vertices.UseWorldCS = true
'      tLength = Sqr((Gr.Vertices(0).X - tNorth.Vertices(0).X)^2 + (Gr.Vertices(0).Y - tNorth.Vertices(0).Y)^2 + (Gr.Vertices(0).Z - tNorth.Vertices(0).Z)^2)

'      Gr.MoveRelative tNorth.Vertices(0).X - Gr.Vertices(0).X + dX * tLength ,tNorth.Vertices(0).Y - Gr.Vertices(0).Y + dY * tLength, tNorth.Vertices(0).Z - Gr.Vertices(0).Z + dZ * tLength
'      tNorth.Vertices.UseWorldCS = false
'      Gr.Vertices.UseWorldCS = false

   end if
   Gr.Update


   



end if



end function

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------



HERE IS MY MODIFIED VERSION TO MOVE A SPHERE:- SpMoveSphere.txt

' From(0) To(-) Sphere\SPMoveSphere(FFFF) CenterNorth(ActorName) Latitude(0) DayOfYear(1) TimeOfDay(12.0)

function RunCustomCommand(Gr,commandStr,nCount, StAniEditor)
Dim tCentre, tLatitude, tDay, tTime, retVal, xStepCount, xStepNum
Dim tNorth
retVal = GetErrorString(ERR_COMMANDSYNTAXERROR, commandStr)
Dim tP1, tP2

if nCount <> 6 then exit function

   ' For some reason
   '   call GetParameterN(commandStr,1, tCentre)
   ' fails, so for the meantime use a workaround

      tP1 = InStr(commandStr, "SPMoveSphere ") + 10
      tP2 = Instr(tP1, commandStr, " ")
      tCentre = Mid(commandStr, tP1, tP2-tP1)
      'Alert tCentre
      set tNorth = GetActorFromName(tCentre)
      tNorth.Vertices.UseWorldCS = true
      if (tNorth.Vertices.Count < 2) then
         Alert "CentreNorth must have at least two vertices"
         exit function
      end if
      if (tNorth.Vertices(0).Z > 0.00001 Or tNorth.Vertices(1).Z > 0.00001) then
         Alert "CentreNorth Actor must be on the World workplane"
         exit function
      end if
      tNorth.Vertices.UseWorldCS = false

   call GetParameterN(commandStr,2, tLatitude)   ' Decimal latitude (South negative)
   call GetParameterN(commandStr,3, tDay)      ' Day of year where 1 Jan = 1
   call GetParameterN(commandStr,4, tTime)      ' 24hr local Time, does not allow for timezone/longitude discrepancies


if (bCheckScenarioMode = false and (StepNum >= From1) and (StepNum <= To1))  then


   ' Calculate dXYZ from LDT
   xStepCount = To1 - From1
   xStepNum = StepNum - From1
   'Calculate the apparent position of the sun at given position & time
   'Puts values in appropriate text boxes for Preview & Create to use
   'Not perfect, but close. Read ref below for more info.

   'Acknowledgement:
       'This is based on a program written by Dave Rusin, [email protected]
       'Read all about it at http://www.math.niu.edu/~rusin/uses-math/position.sun/

   
        Dim Alpha, Theta, Psi, Noon, tDawn, tDusk
   dim IndTo, xStart, xFinish, AutoInc
   AutoInc = 0.0

       'compute apparent solar position:
       if TypeName(tDay) = "String" then
         if UCase(tDay) = "AUTO" then
            if tLatitude > 0 then
               tDay = 170.3125 + xStepNum / xStepCount * 365.25
            else
               tDay =  -12.3125 + xStepNum / xStepCount * 365.25
            end if
            AutoInc = 365.25/xStepCount
         elseif left(UCase(tDay),4) = "AUTO" then
            IndTo = Instr(5, UCase(tDay), " TO ")
            xStart = trim(mid(tDay, 5, IndTo - 5))
            xFinish = trim(mid(tDay, IndTo + 3))
         
            tDay = xStart + xStepNum / xStepCount * (xFinish-xStart)
            AutoInc  = (xFinish-xStart)/xStepCount

         end if
      end if   
      

       if IsDate(tDay) then
         tDay = DatePart("y", tDay)
       else
          tDay = tDay
       end if

      Dim DescString
      DescString = ""
      DescString = DescString & "Latitude = " & tLatitude
      DescString = DescString & vbCrLf & "Day = " & tDay
      DescString = DescString & vbCrLf & "DayAutoInc = " & AutoInc

      tDay = tDay - 79  'Days since March equinox (approx)



       Alpha = 23.45 * Pi / 180    'Earth slant
       Theta = tLatitude * Pi / 180
       Psi = tDay * 2 * Pi / 365.25
       Noon = Atn(Tan(Psi) * Cos(Alpha))
       If Cos(Theta) * Cos(Psi) * Cos(Noon) < 0 Then Noon = Noon + Pi
      
       Dim tNewTime, A, B, C, F, X
   
      A=cos(Theta)*cos(Psi)
      B=cos(Alpha)*cos(Theta)*sin(Psi)
      C=sin(Alpha)*sin(Theta)*sin(Psi)
      F=sqr(A*A+B*B)
      if F=0 then
         tDawn = 0
         tDusk = 24
      else
         A=A/F
         B=B/F
         C=-C/F

         if B=0 then
            X=A*Pi/2
         else
            X=atn(A/B)
            if B*cos(X)<0 then X=X+Pi
         end if
         
         if abs(C)>1 then
            tDawn = 0
            tDusk = 24
         elseif abs(C)=1 then
            tDawn=((C*Pi/2-X-Noon)*12/Pi+12)
            tDusk=((C*Pi/2-X-Noon)*12/Pi+12)
         else
            tDawn=((atn(C/sqr(1-C*C))-X-Noon)*12/Pi+12)
            tDusk=((Pi-atn(C/sqr(1-C*C))-X-Noon)*12/Pi+12)
            if tDawn > tDusk then
               X=tDawn
               tDawn = tDusk
               tDusk=X
            End If
         end if
      end if

      DescString = DescString & vbCrLf & "Dawn = " & tDawn
      DescString = DescString & vbCrLf & "Dusk = " & tDusk


      AutoInc = 0.0

       if TypeName(tTime) = "String" then
         if UCase(tTime) = "AUTO" then
            tTime = tDawn + xStepNum/xStepCount*(tDusk-tDawn)
            AutoInc  = (tDusk-tDawn)/xStepCount
         elseif left(UCase(tTime),4) = "AUTO" then
            IndTo = Instr(5, UCase(tTime), " TO ")
            xStart = trim(mid(tTime, 5, IndTo - 5))
            xFinish = trim(mid(tTime, IndTo + 3))
            tTime = xStart + xStepNum / xStepCount * (xFinish-xStart)
            AutoInc  = (xFinish-xStart)/xStepCount
         end if
       End if


      DescString = DescString & vbCrLf & "Time = " & tTime
      DescString = DescString & vbCrLf & "TimeAutoInc = " & AutoInc

       'glossing over cases where phi, psi, or theta = +- pi/2
       Phi = Noon + (tTime - 12) * 2 * Pi / 24

'Alert 4
   
   'First Calculate the Earth angles
   Dim dX, dY, dZ, dL, dA
       dX = Round(-Cos(Psi) * Sin(Phi) + Cos(Alpha) * Sin(Psi) * Cos(Phi), 5)
       dY = Round(-Sin(Theta) * Cos(Psi) * Cos(Phi) - Cos(Alpha) * Sin(Theta) * Sin(Psi) * Sin(Phi) + Sin(Alpha) * Cos(Theta) * Sin(Psi), 5)
       dZ = Round(Cos(Theta) * Cos(Psi) * Cos(Phi) + Cos(Alpha) * Cos(Theta) * Sin(Psi) * Sin(Phi) + Sin(Alpha) * Sin(Theta) * Sin(Psi), 5)
       dL = Sqr(dX^2 + dY^2)

       If dX = 0 Then   'North/South
           dA = (Sgn(dY) - 1) * Pi / 2
       ElseIf dY = 0 Then   'East/West
           dA = Sgn(dX) * Pi / 2
       ElseIf dY > 0 Then
           dA = Atn(dX / dY)
       Else
           dA = Atn(dX / dY) + Pi
       End If

       'XYZ Vector is normalised to Length = 1.0

   'Now overlay the north vector

   Dim nX, nY, nL, nA
       tNorth.Vertices.UseWorldCS = true
       nX = tNorth.Vertices(1).X - tNorth.Vertices(0).X
       nY = tNorth.Vertices(1).Y - tNorth.Vertices(0).Y
       tNorth.Vertices.UseWorldCS = false
       nL = Sqr(nX^2 + nY^2)

       If nX = 0 Then   'North/South
           nA = (Sgn(nY) - 1) * Pi / 2
       ElseIf nY = 0 Then   'East/West
           nA = Sgn(nX) * Pi / 2
       ElseIf nY > 0 Then
           nA = Atn(nX / nY)
       Else
           nA = Atn(nX / nY) + Pi
       End If
       'nA = nA - Pi/2

       dX = dL * Sin(dA + nA)
       dY = dL * Cos(dA + nA)

       ' XYZ Vector is still normalised to Length = 0
   
   'Apply to graphic
   Dim tLength
   if Gr.Type = "TCW40Sphere" then
      Gr.Vertices.UseWorldCS = true
      tNorth.Vertices.UseWorldCS = true
      tLength = Sqr((Gr.Vertices(0).X - tNorth.Vertices(0).X)^2 + (Gr.Vertices(0).Y - tNorth.Vertices(0).Y)^2 + (Gr.Vertices(0).Z - tNorth.Vertices(0).Z)^2)

      Gr.Vertices(0).X = tNorth.Vertices(0).X + dX * tLength
      Gr.Vertices(0).Y = tNorth.Vertices(0).Y + dY * tLength
      Gr.Vertices(0).Z = tNorth.Vertices(0).Z + dZ * tLength

      Gr.Vertices(1).X = tNorth.Vertices(0).X
      Gr.Vertices(1).Y = tNorth.Vertices(0).Y
      Gr.Vertices(1).Z = tNorth.Vertices(0).Z

      Gr.Vertices.UseWorldCS = false
      tNorth.Vertices.UseWorldCS = false
      Gr.Properties("Info") = DescString

   else

'      tNorth.Vertices.UseWorldCS = true
'      Gr.Vertices.UseWorldCS = true
'      tLength = Sqr((Gr.Vertices(0).X - tNorth.Vertices(0).X)^2 + (Gr.Vertices(0).Y - tNorth.Vertices(0).Y)^2 + (Gr.Vertices(0).Z - tNorth.Vertices(0).Z)^2)

'      Gr.MoveRelative tNorth.Vertices(0).X - Gr.Vertices(0).X + dX * tLength ,tNorth.Vertices(0).Y - Gr.Vertices(0).Y + dY * tLength, tNorth.Vertices(0).Z - Gr.Vertices(0).Z + dZ * tLength
'      tNorth.Vertices.UseWorldCS = false
'      Gr.Vertices.UseWorldCS = false

   end if
   Gr.Update


   



end if



end function



« Last Edit: March 20, 2014, 10:39:35 AM by Michael Geraghty »

Logged


March 21, 2014, 03:18:37 AM
#1
I don't understand 1 iota of that, but looks impressive!  ;D

Logged
FerrariDrafting (Find me on Facebook)
Australia
V16 deluxe
v17 plat
v19 plat
V20 Plat
V21 Plat
TC2016 plat