Multi Gears using SETATREF Function and Cell.Result Property

[JuneTheSecond]

Thank you for your comments.

Here is a Visio drawing to make involute curve.

A macro makes curve, when you right click on the shape and select a menu "Draw Involute Curve".
This shape has a control. If you move control, the top pf a line will trace on involute curve between -180 deg and +180 deg.

[Visio Guy]

Cool! Reminds me of the old Spiral Maker:
http://www.visguy.com/2006/10/19/spiral-shape-maker/

[Bald Eagle]

 
You have an excellent mastery of the math, how to translate it into code, and how to execute that in VISIO.
I greatly enjoy your creations, Chris' excellent projects on [t]his site, and the work of many other talented people sharing their work.
Thank you again!

[JuneTheSecond]

And here is a Visio drawing with macro that draws involute gear.

[JuneTheSecond]

I found a bug in macro.
Here is a revised Visio drawing.

And applied produced gears to existing Visio drawing of gear set.
Here is a Visio drawing and a short video in YouTube.
https://youtu.be/QDayY1P3fZo

[Bald Eagle]

<whistles>
That's some impressive shape-sheet work I see!
June IS crazy - the good kind of crazy!   
It's a joy to watch him exercise his skill and create things of beauty.

For some reason, I don't seem to be able to get the "draw involute curve" macro to work.

I'm running it in VISIO 2007, on Windows 7 if that matters.
Screenshot of error attached.

[JuneTheSecond]

I am sorry I forget that Visio2007 or younger has no RELMOVETO cell and RELLINETO cell.
Please remove Rel2AbsRows in Sub DrawInvolute.

Sub DrawInvolute(shp As Visio.Shape)
   
.............................
   
    ActiveWindow.DeselectAll
    For Each tmpShp In tmpCol
        ActiveWindow.Select tmpShp, visSelect
    Next
   
    ActiveWindow.Selection.Join
    Rel2AbsRows
    ActiveWindow.Selection.FitCurve 0#, visSplinePeriodic
    Set tmpShp = ActiveWindow.Selection(1)
    tmpShp.Copy

..................................
   
End Sub

[Bald Eagle]

Thank you for that,
I hope everyone had a good holiday and vacation time.


I tried to comment out that variable definition, but when I run the macro I get another error, and when I hit debug I get the attached results.   Perhaps I'm doing something wrong or there's more to getting this to run in 2007 than just that one thing.

[JuneTheSecond]

Sorry, I forgot that PasteToLocation method is available after Visio 2013.
Please, use Paste method and add 2 lines after like

Code

    'To duplicate involute to same location
    InvoluteShp.Copy
'    ActivePage.PasteToLocation InvoluteShp.Cells("PinX").Result(visInches), InvoluteShp.Cells("PinY").Result(visInches), 0
    ActivePage.Paste
    Set tmpShp = ActiveWindow.Selection(1)
    tmpShp.Cells("PinX").Result(visInches) = InvoluteShp.Cells("PinX").Result(visInches)
    tmpShp.Cells("PinY").Result(visInches) = InvoluteShp.Cells("PinY").Result(visInches)

[Bald Eagle]

I'm getting there.
I realize code is very difficult to debug when you don't have the luxury of running it on your own computer in the software it's generating the error in, and being able to rapidly follow the string of interrelated errors.
I've had the "joy" of debugging Python code written in an earlier version and then run in a later version.   :|

Currently I seem to be having problems with the DuplicateShapeToSamePlace subroutine.
It looks like you have tmpshp1, tmpShp2, tmpshp, and InvoluteShp as variables, and I'm running into undefined variable errors and a failure to properly call the sub with the required arguments.   

I wish I was more familiar with VISIO's macro language, but right now I'm just hacking and butchering the code. 
I did however get it to mostly draw the involute curve(s), although they all look like they got rotated out of tangent.

I'll keep working on it.
Can you tell me how to edit the macro code and then save it, and how to clear the drawing page of the macro-generated involute so that I can save the VSD file and re-run the macro with the new edits?

Thanks!

[JuneTheSecond]

how to edit the macro code and then save it,

I am using VBA editor belonging to Visio.

How to clear the drawing page of the macro-generated involute

I almost use undo button to delete shape made by macro.

[pdeepie]

Hi Junichi,

Thank you for generating this tool, I have found it very useful.

Is it possible/easy to modify the VBA code to allow the tooth to be slightly narrower than the space, but the module remains the same. I wanted to use this to design a gear train for a wooden gear clock. It has been suggested that the tooth is about 0.02" to 0.03" smaller and then add that distance back to widen the space.

Many thanks for your feedback.

Pete

[JuneTheSecond]

Is there any document theoretically explaining about the wooden gears you mentioned?
I simply feel that there is no change other than a little delay of angle of rotation.

[wapperdude]

If I had to make a guess, for wood gears, a tight fit might be a problem.  The change requested will loosen the fit, resulting in more backlash.  Otherwise, the teeth might bind and break off.  Just a guess.

Wapperdude

[pdeepie]

Hello

Thank you for your responses.

W is the measurement of the tooth and the space next to it, measured on the curve that defines  the pitch diameter, PD

Tooth width = (w/2) – 0.03”
Tooth space =(w/2) + 0.03"

Wooden gears cannot be as accurate so its sensible to make the tooth narrower than the space to minimise binding of the teeth.

Thank you
Pete