I did a vba version as I have needed this to see how big I can build something to still fit through a given door.
This draws the inner rectangle. Since I don't know lisp it took a while to copy Kerry's to vba. This seemed backwards to the lisp "If Temp > 0 Then then Min = L"
Sub BestFit()
Dim W As Double, H As Double
Dim L As Double, D As Double
Dim X As Double, Y As Double
Dim X1 As Double, Y1 As Double
Dim Pt(2) As Double
Dim Ent As AcadEntity
Dim oP As AcadLWPolyline
Set Ent = EntSel("Pick the rectangular opening:")
If TypeOf Ent Is AcadLWPolyline Then
Set oP = Ent
Else
MsgBox "The opening must be a rectangle."
Exit Sub
End If
If Not UBound(oP.Coordinates) = 7 Then
MsgBox "The opening must be a rectangle."
Exit Sub
End If
X = oP.Coordinates(0)
Y = oP.Coordinates(1)
X1 = oP.Coordinates(2)
Y1 = oP.Coordinates(3)
If Abs(X1 - X) < 0.00000000001 Then 'equals
X1 = oP.Coordinates(4)
End If
If X1 < X Then
X = X1
X1 = oP.Coordinates(0)
End If
If Abs(Y1 - Y) < 0.00000000001 Then 'equals
Y1 = oP.Coordinates(5)
End If
If Y1 < Y Then
Y = Y1
Y1 = oP.Coordinates(1)
End If
Pt(0) = X: Pt(1) = Y
W = X1 - X: H = Y1 - Y
D = ThisDrawing.Utility.GetDistance(, "inside rectangle depth:")
RecInRec W, H, D, Pt
End Sub
Function RecInRec(W As Double, H As Double, _
D As Double, Pt As Variant) As AcadLWPolyline
' based on ( (W+H)/(L+D)^2) + (W-H)/(L-D)^2) = 2
'KerryBrown->vb
Dim L As Double
Dim Max As Double, Min As Double
Dim Temp As Double, fuzz As Double
Dim Attempt As Integer
fuzz = 0.00000000000001
Max = Sqr((W * W) + (H * H))
If D >= W Or D >= H Then
MsgBox "No go"
Exit Function
End If
Do
Attempt = Attempt + 1
If Attempt = 1 Then Min = Max - D 'a square gives the shortest L
L = Min + ((Max - Min) / 2) 'set up a halving solution
Temp = ((W + H) / (L + D)) ^ 2 + ((W - H) / (L - D)) ^ 2 - 2
If Temp > 0 Then
Min = L
Else
Max = L
End If
If Abs(Temp) < fuzz Then
Debug.Print "yes"
End If
Loop Until Abs(Temp) < fuzz
Debug.Print Attempt, L
'Draw the pline
Dim Ang As Double, A As Double, B As Double
Dim X As Double, Y As Double
Dim P(7) As Double
Dim oP As AcadLWPolyline
Dim Ang1 As Double
X = Pt(0): Y = Pt(1)
Ang1 = Atn(D / L)
If H > W Then
If Ang1 > 0.25 * Pi Then Ang1 = Atn(L / D)
Ang = ArcSin(W / (Sqr(D * D + L * L))) - Ang1
Debug.Print Ang * 180 / Pi
B = (Sin(Ang) * D)
A = Abs(Cos(Ang) * D)
Else
Ang = ArcSin(H / (Sqr(D * D + L * L))) - Atn(D / L)
B = Cos(Ang) * D
A = W - Cos(Ang) * L
End If
P(0) = X + A: P(1) = Y
P(2) = X + W: P(3) = Y + H - B
P(4) = X + (W - A): P(5) = Y + H
P(6) = X: P(7) = Y + B
Set oP = ThisDrawing.ModelSpace.AddLightWeightPolyline(P)
oP.Closed = True
Set RecInRec = oP
End Function
