yang686526

length width macro
hi,
the code pasted below is to get the length and width of a part and i have been having alot of trouble with it and was wondering if somebody could help me with it.
i have been playing with this code for quite some time now and just cannot figure out what is wrong. it errors out at "set swconfig = swconfigmgr.activeconfiguration" and also with the math utility. i found this code on this site but it was not complete so i defined almost all the variables so i might have made a mistake there.
dim swapp as sldworks.sldworks
dim swmodel as sldworks.modeldoc2
dim swfeature as sldworks.feature
dim swsheetmetal as sldworks.sheetmetalfeaturedata
dim swbody as sldworks.body2
dim swmassprop as sldworks.massproperty
dim swconfig as sldworks.configuration
dim swconfigmgr as sldworks.configurationmanager
dim swmodelextension as sldworks.modeldocextension
dim swcustompropertymanager as sldworks.custompropertymanager
dim swconfigurationflat as sldworks.configuration
dim swmodelext as sldworks.modeldocextension
dim swmassproperty as sldworks.massproperty
dim swpart as sldworks.partdoc
dim lresults as long
dim dthickness as double
dim vresults as variant
dim dvolume as double
dim vconfig as variant
dim sresults as string
dim bresults as boolean
dim vbody as variant
dim smaterial as string
dim dhoriz as double
dim dvert as double
sub main()
set swapp = application.sldworks
set swmodel = swapp.activedoc
set swfeature = swmodel.firstfeature
do until swfeature is nothing
if swfeature.gettypename = "sheetmetal" then exit do
set swfeature = swfeature.getnextfeature
loop
set swsheetmetal = swfeature.getdefinition
dthickness = swsheetmetal.thickness
set swmodelextension = swmodel.extension
set swmassprop = swmodelextension.createmassproperty
set swconfig = swconfigmgr.activeconfiguration
lresults = swconfig.getchildrencount
if lresults = 0 then exit sub
vconfig = swconfig.getchildren
set swcustompropertymanager = swconfig.custompropertymanager
set swconfigurationflat = vconfig(0)
dim s as integer
if ubound(vconfig) > 0 then
sresults = swconfigurationflat.name
bresults = false
for s = 1 to len(sresults) - 5
if mid(sresults, s, 4) = "flat" then
bresults = true
exit for
end if
next s
if bresults = false then
set swconfigurationflat = vconfig(1)
end if
end if
swmodel.showconfiguration2 (swconfigurationflat.name)
set swmodelext = swmodel.extension
set swmassproperty = swmodelext.createmassproperty
set swpart = swmodel
dvolume = swmassproperty.volume
vbody = swpart.getbodies2(swsolidbody, true)
set swbody = vbody(0)
vresults = getoutsidedimensions(swbody, dthickness, dvolume)
dthickness = conversion(toin, dthickness)
smaterial = swpart.materialidname
dhoriz = round(vresults(0) + 0.499, 0)
dvert = round(vresults(1) + 0.499, 0)
end sub
'you will also need the function getoutsidedimensions
function getoutsidedimensions(swbody as sldworks.body2, dthickness as double, dvolume as double) as variant
dim swface as sldworks.face2
dim darea as double
dim normal as variant
dim dtrans(15) as double
dim vtrans as variant
dim dpoint(2) as double
dim vpoint as variant
dim swmathutil as sldworks.mathutility
dim swmathtrans as sldworks.mathtransform
dim swmathpoint as sldworks.mathpoint
dim vcorner1 as variant
dim vcorner2 as variant
dim vstartpoint as variant
dim vendpoint as variant
dim vcenter as variant
dim dradius as double
dim dangle1 as double
dim dangle2 as double
dim vcurveparams as variant
dim vcircleparams as variant
dim swedge as sldworks.edge
dim vedges as variant
dim swloop as sldworks.loop2
dim vedge as variant
dim dxmin as double
dim dxmax as double
dim dymin as double
dim dymax as double
dim bstart as boolean
dim outside(1) as double
dim swcurve as sldworks.curve
dim dresults as double
set swface = swbody.getfirstface
do while not swface is nothing
darea = swface.getarea
if abs((darea * dthickness) - dvolume) < (dvolume * 0.1) then
exit do
end if
set swface = swface.getnextface
loop
' box = swface.getbox
normal = swface.normal
dtrans(0) = normal(2)
dtrans(1) = normal(0)
dtrans(2) = normal(1)
dtrans(3) = normal(1)
dtrans(4) = normal(2)
dtrans(5) = normal(0)
dtrans(6) = normal(0)
dtrans(7) = normal(1)
dtrans(8) = normal(2)
dtrans(9) = 0
dtrans(10) = 0
dtrans(11) = 0
dtrans(12) = 0
dtrans(13) = 0
dtrans(14) = 0
dtrans(15) = 0
vtrans = dtrans
set swmathutil = swapp.getmathutility
set swmathtrans = swmathutil.createtransform(vtrans)
set swmathtrans = swmathtrans.inverse
dcutlength = 0#
lpiercecount = swface.getloopcount
set swloop = swface.getfirstloop
do
vedges = swloop.getedges
for count = 0 to ubound(vedges)
set swedge = vedges(count)
set swcurve = swedge.getcurve
vedgeparameters = swedge.getcurveparams2
dcurvelength = swcurve.getlength3(vedgeparameters(6), vedgeparameters(7))
dcutlength = dcutlength + dcurvelength
next count
set swloop = swloop.getnext
if swloop is nothing then exit do
loop
set swloop = swface.getfirstloop
do while not swloop is nothing
if swloop.isouter then exit do
set swloop = swloop.getnext
loop
if swloop.getedgecount > 1 then
vedges = swloop.getedges
bstart = false
for each vedge in vedges
set swedge = vedge
vcurveparams = swedge.getcurveparams2
dpoint(0) = vcurveparams(0)
dpoint(1) = vcurveparams(1)
dpoint(2) = vcurveparams(2)
vpoint = dpoint
set swmathpoint = swmathutil.createpoint(vpoint)
set swmathpoint = swmathpoint.multiplytransform(swmathtrans)
vstartpoint = swmathpoint.arraydata
dpoint(0) = vcurveparams(0)
dpoint(1) = vcurveparams(1)
dpoint(2) = vcurveparams(2)
vpoint = dpoint
set swmathpoint = swmathutil.createpoint(vpoint)
set swmathpoint = swmathpoint.multiplytransform(swmathtrans)
vendpoint = swmathpoint.arraydata
if bstart = false then
dxmin = vstartpoint(0)
dxmax = vstartpoint(0)
dymin = vstartpoint(1)
dymax = vstartpoint(1)
bstart = true
else
if vstartpoint(0) < dxmin then dxmin = vstartpoint(0)
if vstartpoint(0) > dxmax then dxmax = vstartpoint(0)
if vstartpoint(1) < dymin then dymin = vstartpoint(1)
if vstartpoint(1) > dymax then dymax = vstartpoint(1)
end if
if vendpoint(0) < dxmin then dxmin = vendpoint(0)
if vendpoint(0) > dxmax then dxmax = vendpoint(0)
if vendpoint(1) < dymin then dymin = vendpoint(1)
if vendpoint(1) > dymax then dymax = vendpoint(1)
next vedge
outside(0) = conversion(toin, dxmax - dxmin)
outside(1) = conversion(toin, dymax - dymin)
getoutsidedimensions = outside
else
' handle complete circle
vedges = swloop.getedges
set swedge = vedges(0)
set swcurve = swedge.getcurve
vresults = swcurve.circleparams
dresults = vresults(6) * 2
outside(0) = conversionmodule.conversion(toin, dresults)
outside(1) = conversionmodule.conversion(toin, dresults)
getoutsidedimensions = outside
end if
end function
'you will also need my unit conversion function
function conversion(numericconversion, nvalue as double) as double
' for solidworks all nominal units are in meters
' therefore all conversions will be to or from meters
select case numericconversion
case inin
conversion = nvalue * 0.0254
case toin
conversion = nvalue * 39.3701
case inmm
conversion = nvalue * 0.001
case tomm
conversion = nvalue * 1000
case incm
conversion = nvalue * 0.01
case tocm
conversion = nvalue * 100
case inm
conversion = nvalue * 1#
case tom
conversion = nvalue * 1#
case inft
conversion = nvalue * 0.3048
case toft
conversion = nvalue * 3.28084
case else
debug.print "unrecognised unit type."
end select
end function
thanks.
solidworks 2006,2007,2008,2009 (office premium.)
core 2 duo e6850 @ 3.00 mhz
window xp pro sp3 32 bit
ati firegl v7350
your first problem is you never define swconfigmgr, you must do that first:
set swconfigmgr = swmodel.configurationmanager
thanks luke,
i am having another error and i think it is with the math utility if i run it errors out at "outside(0) = conversionmodule.conversion(swinches, dresults)" "object required" outside(0) = 0 and the math uitily is also = nothing. just can't see what wrong somthing must not be defined properly yet. anybody got any ideas ? thanks
solidworks 2006,2007,2008,2009 (office premium.)
core 2 duo e6850 @ 3.00 mhz
window xp pro sp3 32 bit
ati firegl v7350
with enough playing around i was able to get it to work but it does not work the i hoped it would. if the part is on an angle then it doesn't work so this macro is useless to me.
well not giving up i found the following code in the api help which i think is suppose to do the trick get and length and width from active part but it does not work.
it has few declaration problems. when i run the code i get a compile error "user-defined type not difined" whith these 2.
dim ooutlinecurve as outlinecurve
dim ooutline as outline
is it something that once existed in solidworks but does not anymore or am i suppose to addin a reference for them ?
option explicit
dim swapp as sldworks.sldworks
sub main()
dim swmodel as sldworks.modeldoc2
dim swpart as sldworks.partdoc
dim swmodeler as sldworks.modeler
dim swmathutility as sldworks.mathutility
dim vbodies as variant
dim swbody as sldworks.body2
dim avector(2) as double
dim vvector as variant
dim swvector as sldworks.mathvector
dim dtolerance as double
dim vcurves as variant
dim vtopologicalentities as variant
dim vindices as variant
dim lnumcurves as long
dim ooutlinecurve as outlinecurve
dim ooutline as outline
dim dictoutlines as scripting.dictionary
dim loutlineidx as long
dim lidx as long
dim voutline as variant
dim voutlinecurve as variant
dim swentity as sldworks.entity
dim swedge as sldworks.edge
dim swface as sldworks.face2
dim bvalue as boolean
dim swcurve as sldworks.curve
dim dstartparam as double
dim dendparam as double
dim bisclosed as boolean
dim bisperiodic as boolean
dim vstartpoint as variant
dim vendpoint as variant
dim vcircleparams as variant
dim acenterpoint(2) as double
dim vtesspts as variant
dim nchordtol as double
dim nlengthtol as double
dim swsketchsegment as sldworks.sketchsegment
dim acolours(5) as long
nchordtol = 0.00000001
nlengthtol = 0.0000000000001
acolours(0) = rgb(255, 0, 0)
acolours(1) = rgb(0, 255, 0)
acolours(2) = rgb(0, 0, 255)
acolours(3) = rgb(255, 255, 0)
acolours(4) = rgb(255, 0, 255)
acolours(5) = rgb(0, 255, 255)
set swapp = application.sldworks
set swmodeler = swapp.getmodeler
set swmathutility = swapp.getmathutility
set swmodel = swapp.activedoc
set swpart = swmodel
vbodies = swpart.getbodies2(swbodytype_e.swsolidbody, false)
' look along the z-axis in the negative direction;
' this corresponds to the front view
avector(0) = 0#
avector(1) = 0#
avector(2) = -1#
vvector = avector
set swvector = swmathutility.createvector((vvector))
' default value
dtolerance = 0.00001
lnumcurves = swmodeler.getbodyoutline((vbodies), swvector, dtolerance, vcurves, vtopologicalentities, vindices)
if (lnumcurves > 0) then
debug.print "#curves = " & lnumcurves
set dictoutlines = new scripting.dictionary
loutlineidx = -1
for lidx = 0 to (lnumcurves - 1)
if (vindices(lidx) <> loutlineidx) then
loutlineidx = vindices(lidx)
set ooutline = new outline
ooutline.lindex = loutlineidx
dictoutlines.add loutlineidx, ooutline
end if
set ooutlinecurve = new outlinecurve
set ooutlinecurve.swcurve = vcurves(lidx)
set ooutlinecurve.swentity = vtopologicalentities(lidx)
on error resume next
set swedge = vtopologicalentities(lidx)
if (not (swedge is nothing)) then
' here: real edge
ooutlinecurve.ntype = swseledges
end if
on error resume next
outlinecurve does not exist anywhere in the sw api. perhaps this macro was written and then the objects removed and restructured.
you can try just creating the objects as they are very simple. just add 2 new classes, one called outline that has this code:
public lindex as integer
public dictcurves as dictionary
private sub class_initialize()
dictcurves = new dictionary
end sub
and one called outlinecurve that has this code:
public swcurve as curve
public swentity as entity
public ntype as long
and see if you code works then
thanks for the reply.
in class "outline" i get an error with dictcurves "argument not optional"
solidworks 2006,2007,2008,2009 (office premium.)
core 2 duo e6850 @ 3.00 mhz
window xp pro sp3 32 bit
ati firegl v7350
make sure microsoft scripting runtime is referenced, and change it to:
set dictcurves = new dictionary
thanks luke for all of your help.
after all this i find this is not the right one either. does any body have a bounding box macro that gets a very acurate length or width regardless if the part is on a plain or not that they would be willing to share ?
solidworks 2006,2007,2008,2009 (office premium.)
core 2 duo e6850 @ 3.00 mhz
window xp pro sp3 32 bit
ati firegl v7350
i was looking for a macro to give the length/width of the part. would be nice if this was in sw already.
cswp
solidworks office professional 2008, sp 3.1
pc #1:
dell precision t3400, core2duo 2.33ghz, 4gb ram,
nvidia quadro fx 1700
pc #2:
dell precision 380, p4 3.80ghz, 2gb ram,
nvidia quadro fx 1400
the bounding box thing is one that many people have tried to accurately solve. i will be doing a 16dp accuracy bounding box solver in one of my next commercial programs and will sell a dll library for .net programmers to add to their programs that can call the function to give the bounding box and width/height/depth etc...
as for vba, i believe there is one out there somewhere that increments degrees to brute force find the bounding box. try searching the forums
hi luke,
i found the macro that increments brute force to find the bounding box but if you want it to be accurate it takes a lot of time to calculate the bounding box.
i was wondering, would it work to select a face and have the macro set the co-ordinet system to line up with the selected face temporarily then just use one of the macros that already exists to calculate the width and length ?
if that is too complicated, would it work to make a drawing of a flat pattern and get the bounding box of the view ?
let me know what you think. thanks
solidworks 2006,2007,2008,2009 (office premium.)
core 2 duo e6850 @ 3.00 mhz
window xp pro sp3 32 bit
ati firegl v7350