fbcadcam redo

For other topics related to the FreeBASIC project or its community.
dodicat
Posts: 6026
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: fbcadcam redo

Postby dodicat » Aug 02, 2013 12:42

The rectangle centre starts at the screen centre, it's direction is towards the bottom left corner.
that is along the line (xres/2,yres/2) to (0,yres)

The gradient of it's line of motion is (dy by dx), i.e. (yres/2-yres)/(0-xres/2)
The normal to a line of gradient dy/dx is -dy/dx.
That is in 2D co-ordinate geometry, normal= -1/gradient.

The length of the side is 2* .5*SmallRectangleHeight*normalize(normal)
Because the normalize(normal) has a length of one unit.

Here's a slight improvement, by making sure that the bottom point is lifted into the screen fully by a do until loop.

Code: Select all


'beeper
'extern "windows" lib "user32"
declare function _Beep alias "MessageBeep" (byval as integer) as integer
'end extern


Type V2D
    As Single x,y
End Type
#define vct Type<V2D>

Function Rotate2D(pivot As V2d,p As V2d,a As Single) As V2D
    var rotx=(Cos(a*.0174533)*(p.x-pivot.x)-Sin(a*.0174533)*(p.y-pivot.y))+pivot.x
    var roty=(Sin(a*.0174533)*(p.x-pivot.x)+Cos(a*.0174533)*(p.y-pivot.y))+pivot.y
    Return vct(rotx,roty)
End Function

Operator + (v1 As V2D,v2 As V2D) As V2D
Return vct(v1.x+v2.x,v1.y+v2.y)
End Operator
Operator -(v1 As V2D,v2 As V2D) As V2D
Return vct(v1.x-v2.x,v1.y-v2.y)
End Operator
Operator * (f As Single,v1 As V2D) As V2D 'scalar*V2D
Return vct(f*v1.x,f*v1.y)
End Operator

Function length(v As V2D) As Single
    Return Sqr(v.x*v.x+v.y*v.y)
End Function

Function normalize(v As V2D) As V2D
    Dim n As Single=length(v)
    If n=0 Then n=1e-20
    Return vct(v.x/n,v.y/n)
End Function

Dim As Integer xres,yres

'====================================================
'INPUTS
Dim As Single SmallRectangleHeight=300


Dim As Single BigRectangleWidth=800
Dim As Single BigRectangleHeight=600

Dim As Single rotateangle=.01  'degrees(tweakable)

'=================================================
If BigRectangleHeight>BigRectangleWidth Then Swap BigRectangleHeight,BigRectangleWidth
Screenres BigRectangleWidth,BigRectangleHeight
Screeninfo xres,yres

Dim As V2D ctr=vct(xres/2,yres/2)'screen centre and centres of rectangles

Dim As Single ds,diffx,diffy,inc
Dim As V2D start,norm,temp,temp2,temp3
Dim As Integer flag
start=vct(0,yres)-ctr
#macro motion(inc)
cls
ds=ds+inc 'motion increments
'(dy/dx)= a gradient, -(dx/dy)= a normal to a gradient
'i/e.  swap start.x,start.y for (dx/dy), then negate.
    norm=vct(-start.y,start.x) 'get the normal vector to the direction of travel
    norm=.5*SmallRectangleHeight*normalize(norm)'make the normal vector size= .5*SmallRectangleHeight
    temp=ctr+ds*start  'move the SmallRectangle centre onwards
    temp2=temp+norm  'top point-red dot
    temp3=temp-norm  'bottom point-red dot
    Line(temp3.x,temp3.y)-(temp2.x,temp2.y)'join top to bottom points
    Circle(temp2.x,temp2.y),3,4,,,,f       'then circle them for the dots
    Circle(temp3.x,temp3.y),3,4,,,,f
#endmacro
Do
    Screenlock
   
    motion(.001)
   
    'Finishing condition
    If temp2.x<=0 Then 'if top point is on the big rectangle(side) i.e done
        diffy=yres-temp2.y:diffx= temp3.x
        'finish off the other rectangle sides
        Line(xres-diffx,0)-(xres,diffy)
        Line(temp3.x,yres)-(xres,diffy)
        Line(xres-diffx,0)-(temp2.x,temp2.y)
        Screenunlock:_Beep(-1):Exit Do
    End If
   
    If temp3.y>=yres Then 'if bottom point is on the big rectangle (base)
        If temp2.x>0 Then 'if top point is still in the big rectangle (screen)
            do
            start=rotate2D(ctr,start,rotateangle)'lift the bottom point up into the screen
            'no forwaed motion while lifting
            motion(0)
            loop until temp3.y<yres
                                               
        End If
    End If
    Screenunlock
    Sleep 1,1
    If Len(Inkey) Then flag=1: Exit Do
Loop
If flag=0 Then
    Print "Length of inside rectangle = ";length(vct(temp3.x,yres)-vct(xres,diffy))
    Print "Height of inside rectangle = ";length(temp2-temp3)
Else
    Print "Exit"
End If

Sleep

 
owen
Posts: 552
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: fbcadcam redo

Postby owen » Aug 02, 2013 13:17

At dodicat _ thanx
note: i am unable to view all your code on my cell phone. I'm a truck driver and will be able to view everything on my laptop in a few days.
the gradient or direction is negative due to decrease in x. it's a ratio is that of the large rectangles height to width. The norm however should be the perpendicular of the chord. Which is what mystifies me as to how you get it spot on correct.
owen
Posts: 552
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: fbcadcam redo

Postby owen » Mar 22, 2017 17:50

Four years later I revisited the rectangle in rectangle problem. Looked at dodicat's work and came up with a solution that iterates from the outside in.

Code: Select all

Dim As Double pi
Dim As Double rad

Dim As Double x,y

Dim As Double r1h,r1w,r1x1,r1y1,r1x2,r1y2,r1x3,r1y3,r1x4,r1y4,r1cx,r1cy
Dim As Double r2h,r2w,r2x1,r2y1,r2x2,r2y2,r2x3,r2y3,r2x4,r2y4
Dim As Double angle,difangle

Dim As Double ba

pi = 4 * Atn(1)
rad=pi/180

r1h=400
r1w=600
r1x1=0
r1y1=r1h
r1x2=r1w
r1y2=r1h
r1x3=r1w
r1y3=0
r1x4=0
r1y4=0
r1cx=r1w/2
r1cy=r1h/2

r2h=250
r2x2=r1x2
r2y2=r1h
angle=atan2((r2h/2),Sqr((r1h/2)^2 + (r1w/2)^2 - (r2h/2)^2)) / rad
difangle=atan2((r1h/2),(r1w/2))/rad - angle
angle=360-angle+difangle
x=r1cx+cos(angle*rad)*sqr((r1h/2)^2 + (r1w/2)^2)

Do While x-r1x2 > .0001
   r2x2=r2x2-(x-r1x2)
   angle=atan2((r2h/2),Sqr((r1h/2)^2 + (r2x2-r1cx)^2 - (r2h/2)^2)) / rad
   difangle=atan2((r1h/2),(r2x2-r1cx))/rad - angle
   angle=360-angle+difangle
   x=r1cx+cos(angle*rad)*sqr((r1h/2)^2 + (r2x2-r1cx)^2)
loop
y=r1cy+sin(angle*rad)*sqr((r1h/2)^2 + (r2x2-r1cx)^2)
r2x1=0
r2y1=r1h-y
r2x3=r1w
r2y3=y
r2x4=r1w-r2x2
r2y4=0

r2w=Sqr((r2x2-r2x1)^2 + (r2y2-r2y1)^2)
Print r2w

Line(r1x1,r1y1)-(r1x2,r1y2)
Line(r1x2,r1y2)-(r1x3,r1y3)
Line(r1x3,r1y3)-(r1x4,r1y4)
Line(r1x4,r1y4)-(r1x1,r1y1)

Line(r2x1,r2y1)-(r2x2,r2y2)
Line(r2x2,r2y2)-(r2x3,r2y3)
Line(r2x3,r2y3)-(r2x4,r2y4)
Line(r2x4,r2y4)-(r2x1,r2y1)


Return to “Community Discussion”

Who is online

Users browsing this forum: No registered users and 0 guests