TheSwamp
Code Red => VB(A) => Topic started by: MickD on December 06, 2007, 09:11:09 PM
-
I'm working on a little lib for transforming entities etc in vba, I've made a bit of a start but as I haven't touched vba in years I am more than a little rusty on the finer points of some syntax and proper structure.
Any pointers on how to proceed with this?
My first problem I see is assigning arrays to other arrays, is there an easier way than assigning each item to each item in the other array, I don't seem to be able to do things like this without compile errors -
Dim a1(2) As Double, a2 As Double
'fill a1 up with some values
'
'assign a1 to a2
a2 = a1 ' <- don't work
as you can see in the code below I have been using Variants to pass return values and then assigning the individual elements to my proper arrays, is there a better way?
thanks.
'''''''''------- Vector Methods --------------'''''''''''
Public Function VecNorm(vec() As Double) As Double()
'Normalises the incoming vector.
Dim vecn(2) As Double
Dim unit As Double
unit = Sqr(vec(0) * vec(0) + vec(1) * vec(1) + vec(2) * vec(2))
vecn(0) = vec(0) / unit: vecn(1) = vec(1) / unit: vecn(2) = vec(2) / unit
VecNorm = vecn
End Function
Function VecCross(v1() As Double, v2() As Double) As Variant
Dim vec(2)
vec(0) = v1(1) * v2(2) - v2(1) * v1(2)
vec(1) = v1(2) * v2(0) - v2(2) * v1(0)
vec(2) = v1(0) * v2(1) - v2(0) * v1(1)
VecCross = vec
End Function
'''''''''--------- Matrix Methods ------------'''''''''''
Public Function xFormMat(vx() As Double, vy() As Double, vz() As Double) As Variant
'Uses the incoming vectors to transform the entity being passed in
Dim mat(0 To 3, 0 To 3) As Double
mat(0, 0) = vx(0): mat(0, 1) = vy(0): mat(0, 2) = vz(0): mat(0, 3) = 0#
mat(1, 0) = vx(1): mat(1, 1) = vy(1): mat(1, 2) = vz(1): mat(1, 3) = 0#
mat(2, 0) = vx(2): mat(2, 1) = vy(2): mat(2, 2) = vz(2): mat(2, 3) = 0#
mat(3, 0) = 0#: mat(3, 1) = 0#: mat(3, 2) = 0#: mat(3, 3) = 1#
xFormMat = mat
End Function
Public Function GetMatFromLine(line As AcadLine) As Variant
'builds a matrix based on the line's sp, ep and normal
Dim mat(0 To 3, 0 To 3) As Double
Dim vx(2) As Double, vy(2) As Double, vz(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:
Dim retvec As Variant
retvec = VecNorm(vz)
vz(0) = retvec(0): vz(1) = retvec(1): vz(2) = retvec(2)
'get the line's normal for the x vector:
vx(0) = line.Normal(0)
vx(1) = line.Normal(1)
vx(2) = line.Normal(2)
'create the y vector by xproduct of z over x:
retvec = VecCross(vz, vx)
vy(0) = retvec(0): vy(1) = retvec(1): vy(2) = retvec(2)
'normalise it:
retvec = VecNorm(vy)
vy(0) = retvec(0): vy(1) = retvec(1): vy(2) = retvec(2)
'plug 'em into the matrix:
mat(0, 0) = vx(0): mat(0, 1) = vy(0): mat(0, 2) = vz(0): mat(0, 3) = 0#
mat(1, 0) = vx(1): mat(1, 1) = vy(1): mat(1, 2) = vz(1): mat(1, 3) = 0#
mat(2, 0) = vx(2): mat(2, 1) = vy(2): mat(2, 2) = vz(2): mat(2, 3) = 0#
mat(3, 0) = 0#: mat(3, 1) = 0#: mat(3, 2) = 0#: mat(3, 3) = 1#
GetMatFromLine = mat
End Function
I have quite a few more to add and will post them but I would like some advice before I produce too much rubbish :)
-
Hi Mick. Warning, the following is not the best expressed post I've ever authored.
If you employ User Defined Types (UDT), (which to speak curly brace speak would be loosely analogous to structs) you can set one UDT var to another UDT var of the same type and it copies the data (kinda like an OO deep clone) from one to the other, rather than assigning the pointer (I'm abusing the language here because a UDT variable is not a pointer) to the other (which is what would happen if they were objects rather than UDTs).
Could this be exploited for your app?
Perhaps, via matrix and vector defined types. Having said that I'm a moron when it comes to matrix / vector math so I can't say.
Do you want a simple UDT code example?
-
Could this be exploited for your app?
I was thinking of creating some classes and it seems logical but I could get away with a few functions, I only have to write them once, I'm just being lazy :)
Do you want a simple UDT code example?
Yep, why not - we are talking about vb classes aren't we?
-
we are talking about vb classes aren't we?
Nope. User Define Types are not classes. Think C structs for closest analogous data type that you're familiar with.
Let me bang out an example to illuminate ...
-
>>C structs
Cool!
I do have just one last problem though, say I have a matrix udt, I will still need to assign it to an array to pass to a transformBy method though...although I could right a function to do that on the fly I guess.
-
Quick and dirty, hope it illuminates.
Option Explicit
Type TPoint
X As Double
Y As Double
Z As Double
End Type
Type TLine
P1 As TPoint
P2 As TPoint
End Type
Sub Demo ( )
Dim P1 As TPoint, _
P2 As TPoint
With P1
.X = 20
.Y = 20
End With
'' Set P2 = P1, remembering it's a copy of the data.
'' Not the same as setting one object to another.
'' If you're a .NET geek think of UDTs as value types
'' (as opposed to reference types).
P2 = P1
'' Show P2's data
With P2
Debug.Print "P2's initial data:"
Debug.Print "P2.X ="; .X; ", P2.Y = "; .Y
Debug.Print
End With
'' prove P2 is not a pointer to P1 by assigning new
'' data to P1 and reprinting P2's data
With P1
.X = 10
.Y = 10
End With
'' show p2's data again (ha, still 20, 20)
With P2
Debug.Print "P2's data after P1 given new values:"
Debug.Print "P2.X ="; .X; ", P2.Y = "; .Y
Debug.Print
End With
'' now demonstrate a deeper copy
Dim L1 As TLine, _
L2 As TLine
'' initialize L1 using previously defined P1 and P2
With L1
.P1 = P1
.P2 = P2
End With
'' now force L2 to have a copy of L1's data (the deeper copy)
L2 = L1
'' show L2's data
With L2
Debug.Print "L2's data:"
Debug.Print "L2, P1.x = "; .P1.X; " , P1.y = "; .P1.Y
Debug.Print "L2, P2.x = "; .P2.X; " , P2.y = "; .P2.Y
End With
'' ha, cool you say; not too shabby for vb.
End Sub
Have fun.
:)
-
Thanks MP, will give that a go over the week end, the 19th is calling here ;)
I'll let you know how I get on.
thanks again.
-
My pleasure Mick. Will be interesting to see how your solution turns out.
-
Wow, MP, that is very enlightening.
I was about to suggest:
Dim a1(2) As Double, a2() As Double 'a2 as dynamic
'fill a1 up with some values
'
'assign a1 to a2
a2 = a1 ' <- Should work
and
Function VecCross(v1() As Double, v2() As Double) As Double()
But this method is not nearly as versatile as the one you posted.
-
To make your code more concise use these syntaxes
Sub Test()
Dim A1(2) As Double
Dim A2() As Double
Dim A3() As Double
Dim Var As Variant
A1(0) = 1: A1(1) = 1: A1(2) = 2
A2() = A1()
Var = A1()
A3() = Var
End Sub
Note: The array must de declared without any elements to be able to assign another array to it.
-
Wow, MP, that is very enlightening.
It's what we had before BASIC went OO Lite.
:-)
-
@MP,
mytwocents
I think there's a flipside to your solution. Most, if any, Acad functions don't accept UDT's.
This can be a problem converting a point in WCS to UCS coordinates or vicaversa for instance.
using Doublearrays and variants won't have that problem.
Oh and an addition for copying initialized indexed arrays... the hard way. Use this if you can't avoid it.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, Source As Any, ByVal numBytes As Long)
Sub Test()
Dim P1(2) As Double
Dim P2(2) As Double
'P1(0) = 1: P1(1) = 2: P1(2) = 3
CopyArray P1, P2
MsgBox (P2(2))
End Sub
Sub CopyArray(Source() As Double, Target() As Double)
Dim NumOfBytes As Long
On Error GoTo NoElements
NumOfBytes = (UBound(Source) + 1) * LenB(Source(0))
ReDim Target(UBound(Source)) 'no need for a diffrent number of items to be a
'true copy and save checking if the target is large enough...
CopyMemory Target(0), Source(0), NumOfBytes
NoElements:
MsgBox "Empty Source array in Sub CopySourceArray() at " & Format$(Now(), "hh:nn ss"), vbCritical + vbOKOnly + vbMsgBoxSetForeground, "Void Array."
On Error GoTo 0
Exit Sub
End Sub
-
Hi Berend.
Agreed, AutoCAD doesn't generally accept UDTs.
I wouldn't however dismiss them outright solely for the reason. Like many encapsulated solutions, what is employed under the covers may be fully hidden to the caller.
The developer must ask him/herself lots of questions, like ... Intrinsic or Win32 API based techniques? Are there performance implications? Are there potential migration issues? How flexible is a given technique? Does it align well with with the problem domain and fundamental data types? Does it avoid variants (blech)? Does it easily map to other languages? etc.
I was just anteing up food for thought. It may or may not prove to be the most efficient way for Mick to pen his solution. I'm just trying to do my part by identifying some options. I thank you because you are doing the same.
:)
-
Another example for Mick, observe --
Option Explicit
Type TPoint
Coord(0 To 2) As Double
End Type
Sub AnotherDemo ( )
Dim P1 As TPoint
P1.Coord(0) = 10
P1.Coord(1) = 20
Dim P2 As TPoint
P2 = P1
Debug.Print P2.Coord(0)
Debug.Print P2.Coord(1)
End Sub
:)
-
I use a variant a lot to pass the double, while it is a little slower sometimes it comes in handy as you can use ismissing to detect whether it is passed or not.
The following sub shows the variant as being twice as slow though
Sub PassTheDoubly()
Dim P1(2) As Double
Dim P2(2) As Double
Dim V As Variant
Dim i As Long, j As Integer
Dim T As Single
T = Timer
P1(0) = 23: P1(1) = 23: P1(2) = 23
For i = 0 To 1000000
For j = 0 To 2
P2(j) = P1(j)
Next j
Next i
Debug.Print "double time=" & Timer - T
T = Timer
For i = 0 To 1000000
V = P1
Next i
Debug.Print "Var time=" & Timer - T
End Sub
double time=0.375
Var time=0.875
-
@Ml
I agree your option to use a double array in an UDT is very elegant.
and for compatibility I don't worry aboout RtlMoveMemory it's an windows Api and i've never heard of a
officially documented api that was made redundant.
So i was in doubt... do i prefer the oopy UDT (I prefer OOP in general) or is an array better in this case.
@All Readers
I saw Bryco's post and it made me think... I've expanded his test a bit to see about other techniques...
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, Source As Any, ByVal numBytes As Long)
Type Point3d
Coord(0 To 3) As Double
End Type
Sub PassTheDoubly()
Dim P1(2) As Double
Dim P2(2) As Double
Dim P3() As Double
Dim Udt1 As Point3d
Dim Udt2 As Point3d
Dim V As Variant
Dim i As Long, j As Integer
Dim T As Single
'Walking through the items one by one
T = Timer
P1(0) = 223: P1(1) = 123: P1(2) = 323
Udt1.Coord(0) = 223: Udt1.Coord(1) = 123: Udt1.Coord(2) = 323
For i = 0 To 10000000
For j = 0 To 2
P2(j) = P1(j)
Next j
Next i
Debug.Print "double time by element = " & Timer - T
'Using a variant
T = Timer
For i = 0 To 10000000
V = P1
Next i
Debug.Print "Var time = " & Timer - T
'Using UDT's
T = Timer
For i = 0 To 10000000
Udt2 = Udt1
Next i
Debug.Print "Udt time = " & Timer - T
'Using Arrays and rtlmovememory api
T = Timer
For i = 0 To 10000000
CopyMemory P1(0), P2(0), 24
Next i
Debug.Print "Rtlmovememory time = " & Timer - T
'Using non dimensioned array and pass ditrectly
T = Timer
For i = 0 To 10000000
P3() = P1()
Next i
Debug.Print "Direct Array passing = " & Timer - T
End Sub
I was aqmazed by the results:
double time by element = 5,125
Var Time = 14, 9375
Udt Time = 0, 96875
Rtlmovememory Time = 2
Direct Array passing = 13,9375
So UDT is the way to go in general.
BTW this is the first example I know of that OOPY coding is faster then straight forward coding.
edit: replaced Code Tag
-
Cool stuff Berend, thanks for sharing your test results.
Small AR clarification, using UDTs is not OOPY. UDT vars are not objects in VBA/VB6 (they are in VB.NET merely because everything is an object, but are value types, not reference types).
Sorry, really can't help myself.
:)
Regarding variants --
My stance on variants is "Use 'em when it's the only way you can communicate to the outside world"; otherwise avoid them, especially in implementation code.
I made reference to this earlier, but I think it bears mentioning on it's own --
One needs to consider the implications techniques / data type have with regards to migration and upgrading. Variants are not supported by VB.NET. User Defined Types (UDFs) are and can be used natively, albeit the syntax has slightly changed:
Whereas VBA / VB6 and predecessors used --
Type MyContainer
element as [DataType]
End Type
They're now (properly) referred to as Structures, and defined thusly --
Structure MyContainer
Dim | Public | Friend | Private element As [DataType]
End Structure
Functionally, at least in cursory testing, they work similarly (i.e. once instanced), complete with element by element data copying.
:)
-
Definately a cool test.
The copymemory actually fairs worse than posted as it is only swapping one of the 3 doubles.
CopyMemory P1(0), P2(0), 24
Even though it says any in the api I couldn't get it to CopyMemory V(0), V2(0), 24
-
As Michael said, I think udt's would be good for under the covers work but when I have to pass say a matrix to acad I am still going to have to pass a double array as it seems a variant doesn't work.
I think I'll either have to make my returns from functions double arrays (but I'm not sure if even that worked, will experiment) or use Variants and write a quite assign to array function or similar. Either way I only need to write it once even if it is tedious, I didn't think the speed between Variants and other types would differ by so much also, something to consider.
I was almost going to write classes for vecs and matrices but really, they are just arrays at the end of the day and I just need functions to work on them so why complicate things.
This is another place where Python excels, it works out the details such as these for you on the fly which is exactly what you need when scripting like this.
Beleive it or not, I was going to write some base functions in arx and write python wrappers for them and embed the interpretor in acad...but then I woke up :)
thanks All for your input.
-
@Mp
Granted an UDT isn't an object. It's just more structured then an array. I've used OOPY to indicate I'm aware VBA nor VB6 is a full OOP language. I'm writting or better trying to write VB.Net myself.
On the matter of using variant I agree, use them only if you have to.... something the acad object does way to often due to sloppy codding of functions.
@Bryco
A variant is a bit of a tricky thing... It can be in several states. Containing a native type, containing an array (in VB6 even arrays... Yes it's the way to make jagged arrays) Containing an object, and perhaps even diffrent on containing fixed types or variable length types. I Know for sure that the first two Bytes are used to contain the vartype the variant contains (Programming visual basic 6.0 by Francesco Balena) Normally only bytes 7 to 15 are used to store data or pointer to data.
1 exeption it uses byte 3 to 15 to store a decimal
And no... it did copy 3 Doubles, A double is 8 Bytes... 3*8 = 24
@MickD
Writing classes does have some benefits in being able to store an double array and add some extra functionallity on the side like maxvalue, minvalue, average, some transposing functionality... etc.
And nice to read you again... it's been a while.
-
You too Berend, yes it has been a while, it's like starting from scratch although these days I have a bit better idea what I want to do and how to do it...I think :)
I was thinking "this passing things back and forth, creating temp var's and assinging things twice is just crazy talk", then it dawned on me, what I need is a pointer. I then remembered the ByRef keyword and give it a fling. I think this is what I need, back to the drawing board...
Public Function initarray(ByRef arr() As Double)
arr(0) = 1: arr(1) = 3
End Function
Public Sub test()
Dim a(0 To 1) As Double
initarray a
Debug.Print a(0) & "," & a(1)
End Sub
-
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?).
''''''''------- 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(ByRef mat() As Double, ByRef vx() As Double, _
ByRef vy() As Double, ByRef vz() As Double)
'Uses the incoming vectors to transform the entity being passed in
mat(0, 0) = vx(0): mat(0, 1) = vy(0): mat(0, 2) = vz(0): mat(0, 3) = 0#
mat(1, 0) = vx(1): mat(1, 1) = vy(1): mat(1, 2) = vz(1): mat(1, 3) = 0#
mat(2, 0) = vx(2): mat(2, 1) = vy(2): mat(2, 2) = vz(2): mat(2, 3) = 0#
mat(3, 0) = 0#: mat(3, 1) = 0#: mat(3, 2) = 0#: mat(3, 3) = 1#
End Function
Public Function MatFromLine(line As AcadLine, ByRef 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
'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)
'create the y vector by xproduct of z over x:
VecCross vy, vz, vx
'normalise it:
VecNorm vy
'plug 'em into the matrix:
BuildMat mat, vx, vy, vz
End Function
BTW, this code has not been tested in the feild yet and is subject to strange things happening to your drawing ent's :)
-
Quick observations Mick, offered in the remote chance they may be helpful.
Do all those functions want to be subs since they have no return values? Or are you thinking down the road they'll return values?
Do all the functions / subs need to be public? Viewed thru my goggles I get the impression the only one that need be public is MatFromLine.
In MatFromLine array vy() ins not initialized to any values. Not knowing vector / matric math, is assuming all 0's ok? Would it be better if it's explicitly initialized to 0's, in particular if this library heads at some point to VB.NET where, correct me if I'm wrong, non initialized variables might chuck a compiler caution?
Things that make me go hmmmm.
:)
-
Quick observations Mick, offered in the remote chance they may be helpful.
Do all those functions want to be subs since they have no return values? Or are you thinking down the road they'll return values?
So, as a rule of thumb, use subs if not returning a value else use functions. Check ;)
Do all the functions / subs need to be public? Viewed thru my goggles I get the impression the only one that need be public is MatFromLine.
True, but I will never know when I could use the others, such as the dot product to determine which way two vec's or lines are pointing for instance, have have been pondering this also but for now I'll leave them public.
In MatFromLine array vy() ins not initialized to any values. Not knowing vector / matric math, is assuming all 0's ok? Would it be better if it's explicitly initialized to 0's, in particular if this library heads at some point to VB.NET where, correct me if I'm wrong, non initialized variables might chuck a compiler caution?
true, but I do initialise it in the method with the xproduct of the other two vec's. I doubt that I would port it to .net, this will do me for a couple of years, by then I may be doing something else I hope :)
It's still food for thought though, all good points, thanks MP.
-
Here's a sub ('test' at the bottom) using the methods above, it xforms an object to the same direction of a given line, it will later be modified for my 3dsolid section creator that creates the section, transforms and translates the object to the 'construction line' or wire frame line in steel modeling terms if you like.
There is no error checking so it will fail if you do the wrong thing, error checking is next on my hit list before going too much further.
Here's the code, I have altered the MatFrom line function also to cater for strange lines like these (it didn't build an orthoganal matrix).
There's a dwg attached with a cylinder and a line at a strange angle in space if you like but it should work with any object, run the sub, follow the prompts and it should xform the cylinder to the same direction as the line.
''''''''------- 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(ByRef mat() As Double, ByRef vx() As Double, _
ByRef vy() As Double, ByRef vz() As Double)
'Uses the incoming vectors to transform the entity being passed in
mat(0, 0) = vx(0): mat(0, 1) = vy(0): mat(0, 2) = vz(0): mat(0, 3) = 0#
mat(1, 0) = vx(1): mat(1, 1) = vy(1): mat(1, 2) = vz(1): mat(1, 3) = 0#
mat(2, 0) = vx(2): mat(2, 1) = vy(2): mat(2, 2) = vz(2): mat(2, 3) = 0#
mat(3, 0) = 0#: mat(3, 1) = 0#: mat(3, 2) = 0#: mat(3, 3) = 1#
End Function
Public Function MatFromLine(line As AcadLine, ByRef 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
'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)
'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 plug 'em into the matrix:
BuildMat mat, vx, vy, vz
End Function
Public Sub test()
'transforms an ent to the same ucs as a given line
'needs error checking so be careful! ;)
Dim line As AcadEntity, obj As AcadEntity
Dim pnt As Variant
Dim transmat(3, 3) As Double
'get the obj and line from user:
ThisDrawing.Utility.GetEntity obj, pnt, "Pick object to xform: "
ThisDrawing.Utility.GetEntity line, pnt, "Pick line to xform to: "
'get the xform matrix from the line:
MatFromLine line, transmat
'xform the obj:
obj.TransformBy (transmat)
obj.Update
End Sub
<edit> Just a quick note, if you use the function again and pick another line, or even the same line again you will get unexpected results.
The reason for this is that the transformations are cumulative. The way around this is to add a user 'ocs' to the solid, retrieve it and for the sake fo simplicity, invert the matrix of the object to transform it back to world then transform it with the given line ocs...hope that makes sense.
-
Thanks for posting your works so far Mick, I'll have a go at it this evening.
:)
-
My pleasure, thanks for the help, you'll be seeing a fair bit of me around here for a while, hope I don't annoy you guys too much with trivial stuff, I don't have time to re-learn everything about vba so some things I ask may be no-brainers, by the time I'm finished though I should have some good routines to contribute.
I better go too, I'm getting those 'looks' from the family I always get when I've been engrossed at the screen for too long :D
-
... thanks for the help, you'll be seeing a fair bit of me around here for a while, hope I don't annoy you guys too much with trivial stuff, I don't have time to re-learn everything about vba so some things I ask may be no-brainers, by the time I'm finished though I should have some good routines to contribute.
Hey, my pleasure. It's not annoying or trivial to me, just good ol' propeller head fun. Looking forward to your final libraries.
Food for thought --
[color=green]''''''''------- Vector Methods --------------'''''''''''[/color]
Function VecNorm (vec() As Double) As Double()
[color=green]'Normalises the incoming vector.[/color]
Dim result(2) As Double, _
unit As Double
unit = Sqr(vec(0) * vec(0) + _
vec(1) * vec(1) + _
vec(2) * vec(2))
result(0) = vec(0) / unit
result(1) = vec(1) / unit
result(2) = vec(2) / unit
[color=red]VecNorm = result[/color]
End Function
Function VecCross(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)
[color=red]VecCross = result[/color]
End Function
[color=green]'''''''''--------- Matrix Methods ------------'''''''''''[/color]
Function BuildMat(vx() As Double, _
vy() As Double, _
vz() As Double) _
As Double()
[color=green]'Uses the incoming vectors to transform the result matrix[/color]
Dim result(3, 3) As Double
result(0, 0) = vx(0)
result(0, 1) = vy(0)
result(0, 2) = vz(0)
result(0, 3) = 0#
result(1, 0) = vx(1)
result(1, 1) = vy(1)
result(1, 2) = vz(1)
result(1, 3) = 0#
result(2, 0) = vx(2)
result(2, 1) = vy(2)
result(2, 2) = vz(2)
result(2, 3) = 0#
result(3, 0) = 0#
result(3, 1) = 0#
result(3, 2) = 0#
result(3, 3) = 1#
[color=red]BuildMat = result[/color]
End Function
Function MatFromLine(line As AcadLine) As Double()
[color=green]'builds the matrix passed in based on the line's sp, ep and normal
'first declare 'em dynamic[/color]
Dim vx() As Double, _
vy() As Double, _
vz() As Double
[color=green]'now give 'em dimensions (this slight of hand allows
'us to assign values to them from functions)[/color]
ReDim vx(2), _
vy(2), _
vz(2)
[color=green]'get the lines ep-sp vector to create the z axis:[/color]
With line
vz(0) = .EndPoint(0) - .StartPoint(0)
vz(1) = .EndPoint(1) - .StartPoint(1)
vz(2) = .EndPoint(2) - .StartPoint(2)
[color=green]'normalise it:[/color]
vz = VecNorm(vz)
[color=green]'get the line's normal for the x vector:[/color]
vx(0) = .Normal(0)
vx(1) = .Normal(1)
vx(2) = .Normal(2)
End With
[color=green]'create the y vector by xproduct of z over x:[/color]
vy = VecCross(vz, vx)
[color=green]'normalise it:[/color]
vy = VecNorm(vy)
[color=green]'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![/color]
vx = VecCross(vy, vz)
[color=green]'now build the matrix:[/color]
[color=red]MatFromLine = BuildMat(vx, vy, vz)[/color]
End Function
Sub Demo( )
[color=green]'transforms an ent to the same ucs as a given line
'needs error checking so be careful! ;)[/color]
Dim line As AcadEntity, _
obj As AcadEntity, _
pnt As Variant, _
transmat() As Double [color=green]'dynamic, rather than static array[/color]
[color=green]'get the obj and line from user:[/color]
With ThisDrawing.Utility
.GetEntity obj, pnt, "Pick object to xform: "
.GetEntity line, pnt, "Pick line to xform to: "
End With
[color=green]'get the xform matrix from the line:[/color]
transmat = MatFromLine(line)
[color=green]'xform the obj:[/color]
With obj
.TransformBy (transmat)
.Update
End With
End Sub
Look ma, only one sub!
(The fruit of the labors is most visible by examining function MatFromLine, though there are at least 2 things to observe in sub Demo).
Later man.
:)
-
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
-
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.
-
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
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
-
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 :)
-
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.
-
....
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.
-
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.
-
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.
-
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.
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:
''''''''------- 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 :)
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