Topic: vector/matrix functions for acad

[Bryco]

Berend I was thrown by the (0) in CopyMemory P1(0), P2(0), 24
after crashing a couple of times i got it.

Messing with stuff a little more

I found that a sub runs faster than a function
(try changing the subs below to functions and compare times)
 Looking at  VecCrossC without() I can't see a reason to add () in the sub call.
vba goes faster when you dim everything.
predimming every double like in VecCrossB is way too much work
whereas VecCrossC is definately worth it in a common function

Code: [Select]

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, Source As Any, ByVal numBytes As Long)

Private retvecTop(2) As Double

Type Point3d
    X As Double
    Y As Double
    Z As Double
End Type

Function Pto3(P() As Double) As Point3d
    Dim P3 As Point3d
    P3.X = P(0): P3.Y = P(1): P3.Z = P(2)
    Pto3 = P3
End Function



Sub VecCross1(retvec() As Double, v1() As Double, v2() As Double)
    retvec(0) = v1(1) * v2(2) - v2(1) * v1(2)
    retvec(1) = v1(2) * v2(0) - v2(2) * v1(0)
    retvec(2) = v1(0) * v2(1) - v2(0) * v1(1)
End Sub


Function VecCross2(v1() As Double, _
                  v2() As Double) _
                       As Double()
                         
    Dim result(2) As Double
   
    result(0) = v1(1) * v2(2) - v2(1) * v1(2)
    result(1) = v1(2) * v2(0) - v2(2) * v1(0)
    result(2) = v1(0) * v2(1) - v2(0) * v1(1)
   
    VecCross2 = result

End Function



Private Sub VecCrossA(retvec() As Double, _
    X1 As Double, Y1 As Double, Z1 As Double, _
    X2 As Double, Y2 As Double, Z2 As Double)
   
    retvec(0) = Y1 * Z2 - Y2 * Z1
    retvec(1) = Z1 * X2 - Z2 * X1
    retvec(2) = X1 * Y2 - X2 * Y1
   
End Sub


Private Sub VecCrossB _
    (X1 As Double, Y1 As Double, Z1 As Double, _
    X2 As Double, Y2 As Double, Z2 As Double)
   
    retvecTop(0) = Y1 * Z2 - Y2 * Z1
    retvecTop(1) = Z1 * X2 - Z2 * X1
    retvecTop(2) = X1 * Y2 - X2 * Y1
   
End Sub


Private Sub VecCrossC(retvec() As Double, v1() As Double, v2() As Double)

   Dim X1 As Double, Y1 As Double, Z1 As Double
   Dim X2 As Double, Y2 As Double, Z2 As Double
    retvec(0) = Y1 * Z2 - Y2 * Z1
    retvec(1) = Z1 * X2 - Z2 * X1
    retvec(2) = X1 * Y2 - X2 * Y1

End Sub

Private Sub VecCrossD(RV As Point3d, P1 As Point3d, P2 As Point3d)
    RV.X = P1.Y * P2.Z - P2.Y * P1.Z
    RV.Y = P1.Z * P2.X - P2.Z * P1.X
    RV.Z = P1.X * P2.Y - P2.X * P1.Y

End Sub


Private Sub VecCrossE(P, v1() As Double, v2() As Double)

    Dim X1 As Double, Y1 As Double, Z1 As Double
    Dim X2 As Double, Y2 As Double, Z2 As Double
    Dim Ans(2) As Double
    Ans(0) = Y1 * Z2 - Y2 * Z1
    Ans(1) = Z1 * X2 - Z2 * X1
    Ans(2) = X1 * Y2 - X2 * Y1
    CopyMemory P(0), Ans(0), 24

End Sub

 
Private Function VecCrossf(v1() As Double, v2() As Double) As Double()

    Dim X1 As Double, Y1 As Double, Z1 As Double
    Dim X2 As Double, Y2 As Double, Z2 As Double
    Dim Ans(2) As Double
    Ans(0) = Y1 * Z2 - Y2 * Z1
    Ans(1) = Z1 * X2 - Z2 * X1
    Ans(2) = X1 * Y2 - X2 * Y1
VecCrossf = Ans

End Function





Sub Test()

    Dim T As Single
    Dim v1(2) As Double, v2(2) As Double
    Dim d() As Double
    Dim i As Long
    v1(0) = 223: v1(1) = 123: v1(2) = 323
    v2(0) = 343: v2(1) = 4: v2(2) = 0
    Dim retvec(2) As Double
    Dim c As Double
   
    T = Timer
    For i = 0 To 1000000
         VecCross1 retvec(), v1(), v2()
         c = retvec(0) + retvec(1)
    Next
    Debug.Print "1=" & Timer - T
   
    T = Timer
    For i = 0 To 1000000
         VecCrossA retvec(), v1(0), v1(1), v1(2), v2(0), v2(1), v2(2)
         c = retvec(0) + retvec(1)
    Next
    Debug.Print "A=" & Timer - T

   
    T = Timer
    For i = 0 To 1000000
         VecCrossB v1(0), v1(1), v1(2), v2(0), v2(1), v2(2)
         c = retvecTop(0) + retvecTop(1)
    Next
    Debug.Print "B=" & Timer - T


    T = Timer
    For i = 0 To 1000000
         VecCrossC retvec(), v1(), v2()
         c = retvec(0) + retvec(1)
    Next
    Debug.Print "C=" & Timer - T
   
    T = Timer
    For i = 0 To 1000000
         VecCrossC retvec, v1, v2
         c = retvec(0) + retvec(1)
    Next
    Debug.Print "C=" & Timer - T & " without()"
   
   
   
    T = Timer
    Dim P1 As Point3d, P2 As Point3d
    Dim RV As Point3d
   
    P1 = Pto3(v1): P2 = Pto3(v2)
   
    For i = 0 To 1000000
         VecCrossD RV, P1, P2
         c = retvec(0) + retvec(1)
    Next
    Debug.Print "D=" & Timer - T
       
   
End Sub

1=1.730469
A=1.410156
B=1.433594
C=1.230469
C=1.214844 without()
D=1.199219

[MickD]

Ok, that was a lot easier and cleaner too, here's the revised functions, any thought's, am I overusing ByRef and does it have any drawbacks I should be aware of??
As I understand it I'm working on the actual data rather than copies so it should even be a bit faster, obviously though one must be careful when passing arg's that should not be changed by the function (is there a keyword to use for this?).

I believe "ByRef" is the default method of passing variables so would not require explicit declaration (i.e., Public Function VecNorm(ByRef vec() As Double) is the same as Public Function VecNorm(vec() As Double).  The other option you alluded to is "ByVal", which passes a copy of the variable, the original is immune to any operations of the called routine.

Note that array arguments and user-defined type arguments cannot be passed ByVal

Ok, I figured it would be one way or the other, ByVal is the same as saying 'const' in C, thanks for clearing that up..it also saves typing

[MickD]

Mick, as a point of possible interest:

Because a line’s normal could be pointing anywhere, it’s possibly aligned with the line direction.  If that were the case then a “Zero” vector would result from a cross product.

In lieu of additional error checking, could a temporary assignment such as:

Vx(0) = -Vz(1)
Vx(1) = Vz(2)
Vx(2) = Vx(0)

Essentially, something to guarantee non-collinear.

A subsequent VecNorm and VecCross Vy, Vz, Vx  (then another go round to square up Vx )  should preserve the primary bit of information, i.e., line’s direction.

Good point, will have to do some testing, I always thought the 'normal' would be perp to the line but it's orientation around the line would be at least closer to the z axis of ucs it was created in...will get back to you once I find out.

[MickD]

....
Food for thought --
<big snip>
(The fruit of the labors is most visible by examining function MatFromLine, though there are at least 2 things to observe in sub Demo).

I'll chew on that for a while Michael, I will get the rest of the routine fleshed out and post for others to use/abuse first, basically what it will do is insert a block of a closed polyline which is a 'section' to be extruded, the user can pick 2 points or a line and the 3dsolid will be extruded along it.
What this means is you can build a block lib of all of your standard and custom sections and insert them in your model in an intuitive way, the only dialog I use is the openfile dlg to choose the section dwg. Once this is all working as expected I will give it the once over for speed and safety.

[MickD]

SEANT, you are indeed correct, I guess I have just been lucky that I have never encountered an instance where the line's direction equaled the normal. While this would be pretty rare to come across this it is definitely worth checking for, I think a quick dot product would suffice here to check the two are not parallel before branching off to another routine to fix the problem. Thanks again for the heads up.

[MP]

I'll chew on that for a while Michael, I will get the rest of the routine fleshed out and post for others to use/abuse first, basically what it will do is insert a block of a closed polyline which is a 'section' to be extruded, the user can pick 2 points or a line and the 3dsolid will be extruded along it.
What this means is you can build a block lib of all of your standard and custom sections and insert them in your model in an intuitive way, the only dialog I use is the openfile dlg to choose the section dwg. Once this is all working as expected I will give it the once over for speed and safety.

Sounds good++ Mick.

[MickD]

Ok, here's the prototype, there's no error checking so be careful in what you select and do, that's the next refinement.
There are probably glaring errors or bad design but it works and I will refine it once I sort a few other things out also.

What you will need though is a few drawings that contain 1 closed polyline each only, something you would typically use as a block like a steel section or timber profile say. I have our Aussie sections in a directory broken into typical section types and that is the default directory path to open the dialog in. The insert point of your profile should be 0,0,0 to be inserted on a line as expected.

I use almost every math function here but I really like the use of the matrix (MatFromLine) for both transformation and translation at once, pretty easy!

Each code block is in its own module but you can put it where you like I guess.

The sub called by the user.

Code: [Select]

Public Sub draw()
Dim FileList As Variant
Dim fileName As String, filepath As String, tmpstr As String
Dim File As String

'******default file path, change as required:*****'
filepath = "C:\DCS3d\BLUESCOPE SECTIONS\"
'OpenFileDialog to select single file:
FileList = FileDialogs.Open_Comdlg32("AutoCAD Drawing File (*.dwg)" & Chr(0) & "*.dwg" & Chr(0) & _
                         "AutoCAD Drawing Exchange File (*.dxf)" & Chr(0) & "*.dxf" & Chr(0), _
                         "Select Drawing File", _
                         OFN_EXPLORER + OFN_FILEMUSTEXIST, _
                         filepath)
                       
'process the returned FileList:
tmpstr = FileList
fileName = FileNameNoExt(tmpstr)
filepath = FilePathOnly(tmpstr)
'Get rid of last slash:
filepath = Left(filepath, Len(filepath) - 1)

'Create the section:
Dim ent As Acad3DSolid
Dim line As AcadLine, basePnt As Variant
Dim height As Double

'get the line from the user:
ThisDrawing.Utility.GetEntity line, basePnt, "Select a line only:"
DrawSection filepath, fileName, line.Length, ent
ent.Update

'transform it into place:
Dim mat(3, 3) As Double
MatFromLine line, mat
ent.TransformBy (mat)

ThisDrawing.Regen acActiveViewport

End Sub

Public Sub DrawSection(DWGPath As String, DWGName As String, height As Double, objBeam As Acad3DSolid)
' DWGPath - path to dwg-file (w/o slash)
' DWGName - file name w/o extension
' There is no control for these parameters
Dim objLayer As AcadLayer, objRegEnt(0) As AcadEntity, objRegion As Variant
Dim objBlockRef As AcadBlockReference, objBlockExplode As Variant
Dim ptInsert(2) As Double, lCounter As Long
Dim File As String, tmpstr As String

On Error Resume Next

File = DWGPath & "\" & DWGName & ".dwg"
tmpstr = DrawingVersion(File)

ptInsert(0) = 0: ptInsert(1) = 0: ptInsert(2) = 0
  If IsEmpty(ptInsert) Or Err.Number <> 0 Then Exit Sub
  If ThisDrawing.Blocks.Item(DWGName) Is Nothing Then
    Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, _
      DWGPath & "\" & DWGName & ".dwg", 1#, 1#, 1#, 0#)
  Else
    Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, _
      DWGName, 1#, 1#, 1#, 0#)
  End If
  objBlockExplode = objBlockRef.Explode
  objBlockRef.Delete
  For lCounter = LBound(objBlockExplode) To UBound(objBlockExplode)
    If objBlockExplode(lCounter).ObjectName = "AcDbPolyline" Then
      Set objRegEnt(0) = objBlockExplode(lCounter)
      objRegion = ThisDrawing.ModelSpace.AddRegion(objRegEnt)
      Exit For
    End If
  Next lCounter
  Set objBeam = ThisDrawing.ModelSpace.AddExtrudedSolid(objRegion(0), height, 0)
  objRegion(0).Delete
  objRegEnt(0).Delete
End Sub

The Math utils:

Code: [Select]


''''''''------- Vector Methods --------------'''''''''''
Public Function VecNorm(ByRef vec() As Double)
'Normalises the incoming vector.
Dim unit As Double
unit = Sqr(vec(0) * vec(0) + vec(1) * vec(1) + vec(2) * vec(2))
vec(0) = vec(0) / unit: vec(1) = vec(1) / unit: vec(2) = vec(2) / unit
End Function

Function VecCross(ByRef retvec() As Double, ByRef v1() As Double, ByRef v2() As Double)
    retvec(0) = v1(1) * v2(2) - v2(1) * v1(2)
    retvec(1) = v1(2) * v2(0) - v2(2) * v1(0)
    retvec(2) = v1(0) * v2(1) - v2(0) * v1(1)
End Function

'''''''''--------- Matrix Methods ------------'''''''''''
Public Function BuildMat(mat() As Double, vx() As Double, _
                            vy() As Double, vz() As Double, vtrans() As Double)
'Uses the incoming vectors to transform the entity being passed in
'It builds the matrix to perform both transform and translation.

mat(0, 0) = vx(0): mat(0, 1) = vy(0): mat(0, 2) = vz(0): mat(0, 3) = vtrans(0)
mat(1, 0) = vx(1): mat(1, 1) = vy(1): mat(1, 2) = vz(1): mat(1, 3) = vtrans(1)
mat(2, 0) = vx(2): mat(2, 1) = vy(2): mat(2, 2) = vz(2): mat(2, 3) = vtrans(2)
mat(3, 0) = 0#: mat(3, 1) = 0#: mat(3, 2) = 0#: mat(3, 3) = 1#

End Function

Public Function MatFromLine(line As AcadLine, mat() As Double)
'builds the matrix passed in based on the line's sp, ep and normal
Dim vx(2) As Double, vy(2) As Double, vz(2) As Double, movevec(2) As Double

'get the lines ep-sp vector to create the z axis:
vz(0) = line.EndPoint(0) - line.StartPoint(0)
vz(1) = line.EndPoint(1) - line.StartPoint(1)
vz(2) = line.EndPoint(2) - line.StartPoint(2)
'normalise it:
VecNorm vz

'get the line's normal for the x vector:
vx(0) = line.Normal(0)
vx(1) = line.Normal(1)
vx(2) = line.Normal(2)

'!***!Note: we will require some checking here to make sure
' that the line's normal and direction are not colinear!
'TODO: colinear checking of normal.

'create the y vector by xproduct of z over x:
VecCross vy, vz, vx
'normalise it:
VecNorm vy

'we need an extra step here as the line may not
'have been drawn in the same plane as it's ucs when drawn
'so we have to 'square up' the x axis, the order of the
'2 vars to cross is important here!
VecCross vx, vy, vz

'now we have to move it to the line:
movevec(0) = line.StartPoint(0)
movevec(1) = line.StartPoint(1)
movevec(2) = line.StartPoint(2)
'now plug 'em into the matrix:
BuildMat mat, vx, vy, vz, movevec

End Function

And the OpenFileDlg code - many thanks to Keith for that one . There are also a couple of functions to deal with the returned path string that I 'gleaned' from the web

Code: [Select]

Option Explicit

Private Declare Function GetOpenFileName _
                Lib "comdlg32.dll" _
                Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
    lStructSize       As Long
    hwndOwner         As Long
    hInstance         As Long
    lpstrFilter       As String
    lpstrCustomFilter As String
    nMaxCustFilter    As Long
    nFilterIndex      As Long
    lpstrFile         As String
    nMaxFile          As Long
    lpstrFileTitle    As String
    nMaxFileTitle     As Long
    lpstrInitialDir   As String
    lpstrTitle        As String
    flags             As Long
    nFileOffset       As Integer
    nFileExtension    As Integer
    lpstrDefExt       As String
    lCustData         As Long
    lpfnHook          As Long
    lpTemplateName    As String
End Type

Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_EXPLORER = &H80000
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const OFN_SHOWHELP = &H10

Function Open_Comdlg32(ByVal strFilter As String, ByVal strTitle As String, ByVal lStyle As Long, ByVal strStartFolder As String) As Variant

Dim OpenFile As OPENFILENAME

OpenFile.lStructSize = Len(OpenFile)
With OpenFile
    .lpstrFilter = strFilter
    .nFilterIndex = 1
    .lpstrFile = String(4096, 0)
    .nMaxFile = Len(.lpstrFile) - 1
    .lpstrFileTitle = .lpstrFile
    .nMaxFileTitle = .nMaxFile
    .lpstrInitialDir = strStartFolder
    .lpstrTitle = strTitle
    .flags = lStyle
End With

If GetOpenFileName(OpenFile) = 0 Then
 Open_Comdlg32 = GetOpenFileName(OpenFile)
Else
 Open_Comdlg32 = OpenFile.lpstrFile
End If

End Function

 'The following function returns the filename without the extension from the file's full path:
Function FileNameNoExt(strPath As String) As String
    Dim strTemp As String
    strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
    FileNameNoExt = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function
 
 'The following function returns the filename with the extension from the file's full path:
Function FileNameWithExt(strPath As String) As String
    FileNameWithExt = Mid$(strPath, InStrRev(strPath, "\") + 1)
End Function
 
 'the following function will get the path only (i.e. the folder) from the file's ful path:
Function FilePathOnly(strPath As String) As String
    FilePathOnly = Left$(strPath, InStrRev(strPath, "\"))
End Function