This works, finally. David the last part is mirror3d as Mick suggests.

Transpose rather than inverse threw for a while as usual (More brains reqd.)

There is a weird variety of math used here, but they all relate to normals somewhere.

`Option Explicit`

Const PI As Double = 3.14159265358979

Sub Dav()

Dim Ent As AcadEntity

Dim B As AcadBlock

Dim Br As AcadBlockReference

Dim P, M, M1, Ret

Dim Ms As AcadBlock

Dim Obj(0) As Object

Dim C1 As AcadCircle, C2 As AcadCircle

Dim R1 As AcadRegion

Dim sBlock As String

Dim Dist As Double, Ht As Double

Dim Util As AcadUtility

Dim Zero(2) As Double

Set Util = ThisDrawing.Utility

Set Ms = ThisDrawing.ModelSpace

sBlock = "5020760"

Util.GetEntity Ent, P, "Pick the 5020"

If Not TypeOf Ent Is AcadBlockReference Then Exit Sub

If Not Ent.Name = sBlock Then Exit Sub

Set Br = Ent

Set B = ThisDrawing.Blocks(sBlock)

For Each Ent In B

If TypeOf Ent Is AcadRegion Then

Set Obj(0) = Ent

Ret = ThisDrawing.CopyObjects(Obj, Ms)

Set R1 = Ret(0)

R1.Layer = "0"

R1.color = 2

Exit For

End If

Next Ent

Dist = Util.GetDistance(, "Centerline distance")

If Dist < 17.0855 Then

MsgBox ("Distance must be larger than 17")

Exit Sub

End If

Ht = (Dist - 17.0855) / Cos(15 / 180 * PI) + 4

M = BlockRefMatrix(Br)

M1 = Transpose(M)

R1.TransformBy (M1)

Dim Tube As Acad3DSolid

Set Tube = Ms.AddExtrudedSolid(R1, Ht, 0)

R1.Delete

Dim width As Double

Dim inspt(2) As Double

Dim Br2 As AcadBlockReference

width = (Tan(15 / 180 * PI) * (Dist - 17.0855)) + 4.0682

inspt(1) = -width: inspt(2) = -Dist

P = TransformPt2(M1, inspt)

Set Br2 = Ms.InsertBlock(Zero, "5141714", 1, 1, 1, 0)

Br2.Normal = Br.Normal

Br2.Rotation = Br.Rotation

Br2.Move Zero, P

End Sub

Function BlockRefMatrix(oBref As AcadBlockReference) As Variant

Dim V, M(3, 3) As Double, M1, M2

Dim j As Integer

Dim X, Y, Z, ins

Dim Rot As Double

Rot = oBref.Rotation

Z = oBref.Normal

V = GetOcsFromNormal(Z)

X = V(0): Y = V(1)

ins = oBref.InsertionPoint

M1 = RotZ(-Rot)

For j = 0 To 2

M(0, j) = X(j)

M(1, j) = Y(j)

M(2, j) = Z(j)

M(3, j) = ins(j)

Next j

M(3, 3) = 1

If Rot = 0 Then

BlockRefMatrix = M

Else

M2 = M4xM4(M, M1)

BlockRefMatrix = M2

End If

End Function

Function Transpose(Matrix As Variant) As Variant

Dim iCnt As Integer, jCnt As Integer

Dim transMat(0 To 3, 0 To 3) As Double

Dim I As Integer, j As Integer

iCnt = UBound(Matrix, 1)

jCnt = UBound(Matrix, 2)

For I = 0 To iCnt

For j = 0 To jCnt

transMat(I, j) = Matrix(j, I)

Next j

Next I

Transpose = transMat

End Function

Function TransformPt2(M As Variant, P1 As Variant) As Variant

Dim I As Integer

Dim X As Double, Y As Double, Z As Double, d As Double

Dim P(3) As Double

Dim P2(2) As Double

For I = 0 To 2

P(I) = P1(I)

Next

P(3) = 1

For I = 0 To 3

X = X + P(I) * M(0, I)

Y = Y + P(I) * M(1, I)

Z = Z + P(I) * M(2, I)

d = d + P(I) * M(3, I)

Next

P2(0) = X: P2(1) = Y: P2(2) = Z

TransformPt2 = P2

End Function

Function GetOcsFromNormal(N As Variant) As Variant

'Arbitrary Axis Algorithm in dxf help

'N is the normal vector.

'Wy is the world Y axis, which is always (0,1,0).

'Wz is the world Z axis, which is always (0,0,1).

Dim Wy(2) As Double

Dim Wz(2) As Double

Dim Nx As Double, Ny As Double

Dim Ax, Ay, Ocs(1) As Variant

N = NormaliseVector(N)

Wy(0) = 0: Wy(1) = 1: Wy(2) = 0

Wz(0) = 0: Wz(1) = 0: Wz(2) = 1

Nx = N(0): Ny = N(1)

If (Abs(Nx) < 1 / 64) And (Abs(Ny) < 1 / 64) Then

'Ax = Wy X N (where “X” is the cross-product operator).

Ax = Crossproduct(Wy, N)

Else

Ax = Crossproduct(Wz, N)

End If

Ocs(0) = Ax

Ay = Crossproduct(N, Ax)

Ocs(1) = Ay

GetOcsFromNormal = Ocs

End Function

Function RotZ(Ang As Double) As Variant

'Rotate by an angle around the z axis

Dim M

Dim CosAng As Double, sinAng As Double

CosAng = Cos(Ang): sinAng = Sin(Ang)

M = IDMatrix

M(0, 0) = CosAng

M(0, 1) = -sinAng

M(1, 0) = sinAng

M(1, 1) = CosAng

RotZ = M

End Function

Function M4xM4(M1, M2) As Variant

'Matrix x matrix

Dim M(3, 3) As Double

Dim I As Integer, j As Integer

Dim k As Integer

Dim Sum As Double

For I = 0 To 3

For j = 0 To 3

For k = 0 To 3

Sum = Sum + M1(k, j) * M2(I, k)

Next k

M(I, j) = Sum

Sum = 0

Next j

Next I

M4xM4 = M

End Function

Function NormaliseVector(V As Variant) As Variant

Dim Unit As Double

Dim Vn(2) As Double

Unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))

Vn(0) = V(0) / Unit: Vn(1) = V(1) / Unit: Vn(2) = V(2) / Unit

NormaliseVector = Vn

End Function

Function Crossproduct(A, B) As Variant

Dim Ax As Double, Ay As Double, Az As Double

Dim Bx As Double, By As Double, Bz As Double

Dim Unit As Double

Dim c(2) As Double

'get CrossProduct

Ax = A(0): Ay = A(1): Az = A(2)

Bx = B(0): By = B(1): Bz = B(2)

c(0) = Ay * Bz - Az * By

c(1) = Az * Bx - Ax * Bz

c(2) = Ax * By - Ay * Bx

'Convert to unit normal

Unit = Sqr(c(0) * c(0) + c(1) * c(1) + c(2) * c(2))

c(0) = c(0) / Unit: c(1) = c(1) / Unit: c(2) = c(2) / Unit

Crossproduct = c

End Function

Function IDMatrix()

Dim M(3, 3) As Double

Dim I As Integer, j As Integer

M(0, 0) = 1

M(1, 1) = 1

M(2, 2) = 1

M(3, 3) = 1

IDMatrix = M

End Function