Commit 2462c834 authored by Dave Cooper's avatar Dave Cooper

updated arc and arc-constraints for current prototype application.

parent d87ad96b
......@@ -141,7 +141,16 @@ the start and end point of the arc.
(angle)
(if (the start)
(rotate-point (the start) (the center) (the (face-normal-vector :top)) :angle angle)
(the center)))))
(the center)))
(angle-at-point
(point &key negative?)
(let ((projected (inter-line-plane point (the (face-normal-vector :top))
(the center) (the (face-normal-vector :top)))))
(angle-between-vectors (the (face-normal-vector :right))
(subtract-vectors projected (the center))
(the (face-normal-vector :top))
:negative? negative?)))))
......
......@@ -54,6 +54,13 @@
((and (getf (the constraints) :tangent-to)
(getf (the constraints) :at-angle))
:tangent-angle)
((let ((keys (the keys)))
(and (= (length keys) 3)
(= (count :tangent-to keys) 1) (= (count :through-point keys) 1)
(= (count :side-vector keys) 1)))
:tangent-through-point)
((= (count :tangent-to (the keys)) 2)
;:tangent-tangent
(error "ICAD COMPAT line-constrains for keys tangent-to and tangent-to not yet implemented"))
......@@ -73,12 +80,12 @@
:hidden-objects
((constraint-object :type (case (the constraint-type)
(:2-points 'line-constraints-2-points)
(:point-angle 'line-constraints-point-angle)
(:tangent-angle 'line-constraints-tangent-angle))
(:2-points 'line-constraints-2-points)
(:point-angle 'line-constraints-point-angle)
(:tangent-angle 'line-constraints-tangent-angle)
(:tangent-through-point 'line-constraints-tangent-through-point))
:constraints (the constraints)))
:functions
(("Icad Compat function"
tangent-point (constraint-index)
......@@ -192,6 +199,70 @@
(direction-vector (the reference-vector))))
(define-object line-constraints-tangent-through-point (base-object)
:input-slots
(constraints)
:computed-slots
(;;------------- Break out the constraint keywords --------------
(through-point (getf (the constraints) :through-point))
(tangent-to-expr (getf (the constraints) :tangent-to))
(arc (getf (the tangent-to-expr) :arc))
(arc-geometry (getf (the tangent-to-expr) :arc-geometry))
(arc-center (if (the arc-geometry)
(getf (the arc-geometry) :center)
(the arc center)))
(arc-radius (if (the arc-geometry)
(getf (the arc-geometry) :radius)
(the arc radius)))
(side-vector (getf (the constraints) :side-vector))
(arc-plane-normal (if (the arc-geometry)
(getf (the arc-geometry) :side-vector)
(the arc (face-normal-vector :top))))
;;;----------- Calculation ----------------------------------
(new-circle-center (midpoint (the arc-center) (the through-point)))
(end-1 (inter-circle-circle (the arc-center) (the arc-radius)
(the new-circle-center) (3d-distance (the new-circle-center) (the arc-center))
t))
(end-2 (inter-circle-circle (the arc-center) (the arc-radius)
(the new-circle-center) (3d-distance (the new-circle-center) (the arc-center))
nil))
(start (the through-point))
(end-1-angle-between (angle-between-vectors (the side-vector)
(subtract-vectors (the end-1) (the arc-center))
(the (face-normal-vector :top))
:-ve t))
(end-2-angle-between (angle-between-vectors (the side-vector)
(subtract-vectors (the end-2) (the arc-center))
(the (face-normal-vector :top))
:-ve t))
(end (if (< (the end-1-angle-between) (the end-2-angle-between))
(the end-1) (the end-2)))))
(defun reverse-plist (plist)
(let (result)
(mapc #'(lambda(key value)
......@@ -284,42 +355,101 @@ and it automatically trims the result to each point of tangency")
:input-slots (constraints first-tangent-index) ;; first-tangent-index is ignored for this case.
:computed-slots ((point-a (getf (the constraints) :through-point))
(point-b (getf (reverse-plist (the constraints)) :through-point))
:computed-slots ((point-P (getf (the constraints) :through-point))
(point-Q (getf (reverse-plist (the constraints)) :through-point))
(tangent-to (getf (the constraints) :tangent-to))
(tangent-to-line (getf (the tangent-to) :line)) ;; FLAG -- add arc/circle case.
(tangent-to-side-vector (getf (the tangent-to) :side-vector)))
)
(tangent-to-side-vector (getf (the tangent-to) :side-vector))
(P-Q-vector (subtract-vectors (the point-Q) (the point-P)))
(parallel-case? (parallel-vectors? (the tangent-to-line direction-vector) (the P-Q-vector)))
(point-T (when (the parallel-case?)
(let ((bisector-point (midpoint (the point-P) (the point-Q)))
(bisector-vector (cross-vectors (the P-Q-vector) (the (face-normal-vector :top)))))
(inter-line-line bisector-point bisector-vector
(the tangent-to-line start) (the tangent-to-line direction-vector)))))
(point-G (unless (the parallel-case?)
(inter-line-line (the point-P) (the P-Q-vector)
(the tangent-to-line start) (the tangent-to-line direction-vector))))
(circle-C-center (midpoint (the point-P) (the point-Q)))
(circle-C-radius (3d-distance (the circle-C-center) (the point-P)))
(center (if (the parallel-case?)
(the parallel-case-arc center)
(the constrained-circle center)))
(radius (if (the parallel-case?)
(the parallel-case-arc radius)
(the constrained-circle radius)))
(point-A (the tangent-line end))
(circle-D-center (the point-G))
(circle-D-radius (3d-distance (the point-G) (the point-A)))
(point-T1 (inter-line-sphere (the tangent-to-line start)
(the tangent-to-line direction-vector)
(the circle-D-center)
(the circle-D-radius)
(the tangent-to-side-vector))))
:objects ((parallel-case-arc :type (if (the parallel-case?) 'constrained-arc 'null-object)
:arc-constraints (list :through-point (the point-P)
:through-point (the point-Q)
:through-point (the point-T)))
(tangent-line :type 'constrained-line
:line-constraints (list :through-point (the point-G)
:tangent-to (list :arc-geometry
(list :center (the circle-C-center)
:radius (the circle-C-radius)))
:side-vector (cross-vectors (subtract-vectors (the point-G)
(the circle-C-center))
(the (face-normal-vector :top)))))
(constrained-circle :type 'constrained-arc
:arc-constraints (list :through-point (the point-P)
:through-point (the point-Q)
:through-point (the point-T1)))))
(define-object arc-constraints-through-three-points (base-object)
:input-slots (constraints first-tangent-index) ;; first-tangent-index is ignored for this case.
:input-slots (constraints first-tangent-index ;; first-tangent-index is ignored for this case.
(length-backoff 99/100))
:hidden-objects ((sphere-a :type 'sphere :radius (* 1/20 (the radius)) :center (the point-a))
(sphere-b :type 'sphere :radius (* 1/20 (the radius)) :center (the point-b))
(sphere-c :type 'sphere :radius (* 1/20 (the radius)) :center (the point-c)))
:computed-slots ((point-a (getf (the constraints) :through-point))
(point-b (getf (rest (rest (the constraints))) :through-point))
(point-c (getf (rest (rest (rest (rest (the constraints))))) :through-point))
(a-b-length (3d-distance (the point-a) (the point-b)))
(a-b-bisector-start (inter-circle-circle (the point-a) (* 5/8 (the a-b-length))
(the point-b) (* 5/8 (the a-b-length)) t))
(a-b-bisector-end (inter-circle-circle (the point-a) (* 5/8 (the a-b-length))
(the point-b) (* 5/8 (the a-b-length)) nil))
(a-b-vector (subtract-vectors (the point-b) (the point-a)))
(a-b-bisector-start (midpoint (the point-a) (the point-b)))
(a-b-bisector-vector (cross-vectors (the a-b-vector) (the (face-normal-vector :top))))
(b-c-length (3d-distance (the point-b) (the point-c)))
(b-c-bisector-start (inter-circle-circle (the point-a) (* 5/8 (the b-c-length))
(the point-b) (* 5/8 (the b-c-length)) t))
(b-c-length (3d-distance (the point-b) (the point-c)))
(b-c-vector (subtract-vectors (the point-c) (the point-b)))
(b-c-bisector-start (midpoint (the point-b) (the point-c)))
(b-c-bisector-vector (cross-vectors (the b-c-vector) (the (face-normal-vector :top))))
(b-c-bisector-end (inter-circle-circle (the point-a) (* 5/8 (the b-c-length))
(the point-b) (* 5/8 (the b-c-length)) nil))
(center (inter-line-line (the a-b-bisector-start)
(subtract-vectors (the a-b-bisector-end) (the a-b-bisector-start))
(the b-c-bisector-start)
(subtract-vectors (the b-c-bisector-end) (the b-c-bisector-start))))
(center (inter-line-line (the a-b-bisector-start) (the a-b-bisector-vector)
(the b-c-bisector-start) (the b-c-bisector-vector)))
(radius (3d-distance (the center) (the point-a)))))
......@@ -440,6 +570,38 @@ and it automatically trims the result to each point of tangency")
(the reference-arc center))
))))))
(define-object test-arc (base-object)
:objects ((arc :type 'constrained-arc
:arc-constraints (list :through-point (make-point 0 0 0)
:through-point (make-point 1 0 0)
:through-point (make-point 2 1 0))
:radius 10 :center (make-point 0 0 0)
:end-angle (the-child (angle-at-point (make-point 0 1 0))))))
(define-object test-constrained-arc-2 (constrained-arc)
:computed-slots
((arc-constraints (list :tangent-to (list :line (the tangent-line) :side-vector (make-vector -1 0 0))
:through-point (make-point -15 5 0)
:through-point (make-point 15 5 0))))
:hidden-objects ((tangent-line :type 'line
:start (make-point -15 0 0)
:end (make-point 15 1 0))
(sphere-P :type 'sphere
:radius 1
:center (the constraint-object point-P))
(sphere-Q :type 'sphere
:radius 1
:center (the constraint-object point-Q))))
(define-object test-constrained-arc (constrained-arc)
:computed-slots
......
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