Commit 58466c0c authored by Dave Cooper's avatar Dave Cooper

added error messages for cylinder, cone and brep center-of-gravity.

parent a7302be0
......@@ -235,8 +235,17 @@ Partial cylinders and hollow cylinders are supported."
:hidden-objects
((inner-cylinder :type (cond ((and (the :inner-radius-1) (the :inner-radius-2)) 'cone)
((the inner-radius) 'cylinder)
((inner-cylinder :type (cond ((and (the :inner-radius-1) (the :inner-radius-2))
(if (not (and (< (the inner-radius-1) (the radius-1))
(< (the inner-radius-2) (the radius-2))))
(error "inner radius not less than radius for ~a.~%"
(cons 'the (reverse (the root-path))))
'cone))
((the inner-radius)
(if (not (< (the inner-radius) (the radius)))
(error "inner radius not less than radius for ~a.~%"
(cons 'the (reverse (the root-path))))
'cylinder))
(t 'null-part))
:radius (the :inner-radius)
:radius-1 (the :inner-radius-1)
......
......@@ -689,8 +689,11 @@ be faster to compute and exhibit more stability.
:&key ((tolerance (the adaptive-tolerance)) \"Controls how precisely the properties are computed\")"
center-of-gravity
(&key (tolerance (the adaptive-tolerance)))
(scalar*vector (/ (the (volume :tolerance tolerance)))
(getf (the (moments :tolerance tolerance)) :volume-static-moments)))))
(let ((volume (the volume :tolerance tolerance)))
(when (zerop volume) (error "~a is a zero-volume brep. Center-of-gravity cannot be computed.~%"
(cons 'the (reverse (the root-path)))))
(scalar*vector (/ volume)
(getf (the (moments :tolerance tolerance)) :volume-static-moments))))))
......
......@@ -51,8 +51,17 @@ from brep and cylinder"
:pass-down (radius radius-1 radius-2 arc brep-tolerance))
(inner-cylinder :type (cond ((and (the :inner-radius-1) (the :inner-radius-2)) 'simple-cone-solid)
((the inner-radius) 'simple-cylinder-solid)
(inner-cylinder :type (cond ((and (the :inner-radius-1) (the :inner-radius-2))
(if (not (and (< (the inner-radius-1) (the radius-1))
(< (the inner-radius-2) (the radius-2))))
(error "inner radius not less than radius for ~a.~%"
(cons 'the (reverse (the root-path))))
'simple-cone-solid))
((the inner-radius)
(if (not (< (the inner-radius) (the radius)))
(error "inner radius not less than radius for ~a.~%"
(cons 'the (reverse (the root-path))))
'simple-cylinder-solid))
(t 'null-part))
:radius (the :inner-radius)
:radius-1 (the :inner-radius-1)
......
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