Commit 8a543008 authored by Dave Cooper's avatar Dave Cooper

added to geom chapter.

parent 31b91edd
......@@ -263,6 +263,7 @@ additional-header-js (with-cl-who-string ()
(remove nil
`(:item
(:index ,(format nil "~a" (the-object documentation symbol)))
(:label ,(format nil "prim:~(~a~)" (the-object documentation symbol)))
(:textbf ,(format nil "~a~a"
(the-object documentation symbol)
(if (the-object documentation :macro?)
......
(in-package :gdl-user)
(define-object assembly (base-object)
:input-slots
((ground-link-length 15 :settable)
(grounded-link-1-length 8 :settable)
(grounded-link-2-length 5 :settable)
(coupler-link-length 15 :settable)
(coupler-angle-1-d 30 :settable)
(coupler-length-1 10 :settable)
(input-link-index 1 :settable)
(input-link-angle-d 90 :settable)
(angle-increment 10 :settable))
:computed-slots
((input-link-angle (degree (the input-link-angle-d)))
(coupler-angle-1 (degree (the coupler-angle-1-d)))
(ground-1 (translate (the center) :left (half (the ground-link-length))))
(ground-2 (translate (the center) :right (half (the ground-link-length))))
(follower-link-circle (the (grounded-link-circles (- 1 (the input-link-index)))))
(follower-link-ends (mapcar #'(lambda(flag)
(inter-circle-sphere (the input-link-circle center)
(the input-link-circle radius)
(the input-link-circle
(face-normal-vector :top))
(the follower-link-circle center)
(the follower-link-circle radius)
flag))
(list t nil)))
(follower-link-angles (mapcar #'(lambda(point)
(angle-between-vectors
(the follower-link-circle (face-normal-vector :right))
(subtract-vectors point
(the follower-link-circle center))
(the follower-link-circle (face-normal-vector :top))))
(the follower-link-ends)))
(follower-link-angle (apply #'min (the follower-link-angles)))
(follower-link-end (if (near-to? (first (the follower-link-angles))
(the follower-link-angle))
(first (the follower-link-ends))
(second (the follower-link-ends))))
(links (list (the ground-link) (the (grounded-links 0)) (the (grounded-links 1))
(the coupler-link)))
(sorted-links (safe-sort (the links) #'<
:key #'(lambda(link) (the-object link length))))
(shortest-link (first (the sorted-links)))
(longest-link (lastcar (the sorted-links)))
(p-link (second (the sorted-links)))
(q-link (third (the sorted-links)))
(crank-rocker? (and (eql (the grashof-classification) :type-1)
(or (eql (the shortest-link) (the (grounded-links 0)))
(eql (the shortest-link) (the (grounded-links 1))))))
(double-crank? (eql (the shortest-link) (the ground-link)))
(double-rocker? (eql (the shortest-link) (the coupler-link)))
(grashof-classification (cond ((< (+ (the shortest-link length)
(the longest-link length))
(+ (the p-link length)
(the q-link length))) :type-1)
((> (+ (the shortest-link length)
(the longest-link length))
(+ (the p-link length)
(the q-link length))) :type-2)
(t :neutral))))
:hidden-objects
((scratch :type 'assembly
:pass-down (angle-increment
ground-link-length grounded-link-1-length
grounded-link-2-length coupler-link-length
coupler-angle-1-d coupler-length-1
input-link-index input-link-angle-d)))
:objects
(
(follower-link-sphere :type 'sphere
:center (the follower-link-circle center)
:radius (the follower-link-circle radius))
(input-link-circle :type 'circle
:radius (the coupler-link-length)
:center (the (grounded-links (the input-link-index)) end))
(grounded-link-circles :type 'circle
:sequence (:size 2)
:radius (ecase (the-child index)
(0 (the grounded-link-1-length))
(1 (the grounded-link-2-length)))
:center (ecase (the-child index)
(0 (the ground-1))
(1 (the ground-2))))
(ground-link :type 'c-cylinder :radius 0.3
:start (the ground-1) :end (the ground-2)
:display-controls (list :line-thickness 2))
(pivot-1 :type 'cylinder
:center (the ground-link start)
:radius (the ground-link radius)
:length 0.5
:display-controls (list :line-thickness 3)
:orientation (alignment :front (the (face-normal-vector :top))))
(pivot-2 :type 'cylinder
:center (the ground-link end)
:radius (the ground-link radius)
:length 0.5
:display-controls (list :line-thickness 3)
:orientation (alignment :front (the (face-normal-vector :top))))
(grounded-links :type 'c-cylinder
:radius (the ground-link radius)
:sequence (:size 2)
:display-controls (list :color (ecase (the-child index)
(0 :red) (1 :green))
:line-thickness 2)
:circle (the (grounded-link-circles (the-child index)))
:pseudo-inputs (circle)
:start (the-child circle center)
:end (rotate-point (the-child circle start)
(the-child circle center)
(the (face-normal-vector :top))
:angle (if (= (the input-link-index)
(the-child index))
(the input-link-angle)
(the follower-link-angle))))
(coupler-link :type 'coupler-link
:display-controls (list :line-thickness 2 :color :blue)
:pass-down (coupler-angle-1 coupler-length-1)
:start (the (grounded-links 0) end)
:end (the (grounded-links 1) end)))
:functions
((animate
(&key (start-angle-d 0) (end-angle-d 360) (increment (the angle-increment)) (write-pdfs? t))
(let* ((current-angle (the input-link-angle-d))
(angles (list-of-numbers start-angle-d end-angle-d increment))
(count -1) data)
(dolist (angle angles)
(the (set-slot! :input-link-angle-d angle))
(print-variables angle)
(incf count)
(with-error-handling () (push (the coupler-link datum) data))
(when write-pdfs?
(let ((filename (format nil "/tmp/4bar-~2,,,'0@a.pdf" count)))
(with-format (pdf filename :page-width (* 5 72) :page-length (* 5 72))
(write-the view-object cad-output)))))
(the (set-slot! :input-link-angle-d current-angle))
(nreverse data)))))
(define-object coupler-link (line)
:input-slots (coupler-angle-1 coupler-length-1)
:computed-slots ((datum (the edge-1 end)))
:objects
((baseline :type 'line
:pass-down (start end))
(edge-1 :type 'line
:pass-down (start)
:end (rotate-point (translate-along-vector (the start)
(the direction-vector)
(the coupler-length-1))
(the start)
(the (face-normal-vector :top))
:angle (the coupler-angle-1)))
(edge-2 :type 'line
:start (the edge-1 end)
:pass-down (end))))
(in-package :gdl-user)
(define-object tower-assembly (base-object)
:input-slots
((base-height 10)
(height-deviation 5)
(number-of-towers 5))
:objects
((towers :type 'tower
:sequence (:size (the number-of-towers))
:height (+ (* (the-child index) (the height-deviation))
(the base-height))
:center (translate (the center) :right (* (twice
(twice (the-child width)))
(the-child index))))))
This diff is collapsed.
This diff is collapsed.
......@@ -396,7 +396,124 @@ one of the major axes, you can use the "
" and "
(:ref "fig:tower")
" show a stack of boxes, where the rear face of each box is
rotated 2 degrees with respect to the box under it.")))
rotated 2 degrees with respect to the box under it.")
((:subsection :title "Assemblies")
"Objects which you define can be used just like the built-in primitives. This illustrates
why it is important for the positioning and orientation passed into a child object to be "
(:emph "relative")
" to that in the parent. Figures "
(:ref "fig:tower-assembly")
" and "
(:ref "fig:tower-assembly-source")
" show how several towers can be positioned side-by-side, while
maintaining consistent internal positioning and orientation. Figure "
(:ref "fig:tower-assembly-tasty")
" shows how the child towers form an "
(:emph "assembly hierarchy")
" of objects."
((:rendered-figure :caption "Tower Assembly"
:object "tower-assembly"))
((:image-figure :image-file "tower-assembly-tasty.png"
:caption "Tower Assembly as displayed in Tasty"
:width "4in" :height "3in"
:label "fig:tasty-assembly-tasty")))
((:subsection :title "Mechanisms")
((:image-figure :image-file "4-bar-image.png"
:caption "Four-bar Link Mechanism"
:width "5in" :height "3in"
:label "fig:4bar-image"))
"GDL supports mechanisms without need for any special
features. By defining position and orientation of some objects to be
dependent on others, you can set up a mechanism. Figure "
(:ref "fig:4bar-image")
" shows a standard four-bar link mechanism which is defined in the code in
the file "
(:href "run:../examples/4-bar-assembly.gdl" "4-bar-assembly.gdl")
" (this is in the examples directory"
(:footnote "http://github.com/genworks/gendl/tree/master/documentation/tutorial/examples/")
" --- due to its length, the
source is not printed in the manual.")
((:subsection :title "Other Geometric Primitives")
"This chapter has focused mainly on the "
(:texttt "box")
" primitive, because every type of geometric primitive is based upon a "
(:emph "reference box")
". Other primitives have their own sets of input-slots, and their
own ways of being rendered in the various output formats. Basic
2D primitives include:"
(:ul (:li (:texttt "circle")
" described on page "
(:pageref "prim:circle"))
(:li (:texttt "line")
" described on page "
(:pageref "prim:line"))
(:li (:texttt "arc")
" described on page "
(:pageref "prim:arc"))
(:li (:texttt "ellipse")
" described on page "
(:pageref "prim:ellipse"))
(:li (:texttt "bezier-curve")
(:footnote "The simple cubic bezier curve is supported
in the basic GDL and open-source Gendl. More
sophisticated NURBS based curves and surfaces are
supported in the commercial GDL product with the SMLib
geometry kernel. These are covered in chapter "
(:ref "chap:advanced-geometry"))
" described on page "
(:pageref "prim:bezier-curve")))
"Basic 3D primitives include:"
(:ul (:li (:texttt "sphere")
" described on page "
(:pageref "prim:sphere"))
(:li (:texttt "cylinder")
" described on page "
(:pageref "prim:cylinder"))
(:li (:texttt "cone")
" described on page "
(:pageref "prim:cone"))
(:li (:texttt "global-polyline")
" described on page "
(:pageref "prim:global-polyline"))
(:li (:texttt "global-polygon-projection")
" described on page "
(:pageref "prim:global-polygon-projection"))
(:li (:texttt "global-filleted-polyline")
" described on page "
(:pageref "prim:global-polyline"))
(:li (:texttt "torus")
" described on page "
(:pageref "prim:torus"))
(:li (:texttt "route-pipe")
" described on page "
(:pageref "prim:route-pipe"))
))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment