Loading surf/source/brep.lisp +40 −12 Original line number Diff line number Diff line Loading @@ -366,21 +366,49 @@ of this brep. Exact supported format will be documented here when ready." ;; (local-box (the bounding-box)) (%native-faces% (get-faces-from-brep *geometry-kernel* (the %native-brep%))) (%native-edges% (get-edges-from-brep *geometry-kernel* (the %native-brep%))) (%native-regions% (get-regions-from-brep *geometry-kernel* (the %native-brep%))) (%native-shells% (get-shells-from-brep *geometry-kernel* (the %native-brep%))) (%native-vertices% (get-vertices-from-brep *geometry-kernel* (the %native-brep%))) (%native-faces% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-faces-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (%native-edges% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-edges-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (%native-regions% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-regions-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (%native-shells% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-shells-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (%native-vertices% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-vertices-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (faces-ht (let ((ht (make-hash-table :size (the faces number-of-elements)))) (dolist (face (list-elements (the faces)) ht) (setf (gethash (the-object face %native-face%) ht) face)))) ) (setf (gethash (the-object face %native-face%) ht) face))))) :objects Loading surf/source/curve.lisp +31 −20 Original line number Diff line number Diff line Loading @@ -108,8 +108,13 @@ (%reversed?% nil) (%derivative?% nil) (native-curve (when (the native-curve-iw) (get-nurbs-from-curve *geometry-kernel* (the native-curve-iw)))) (native-curve (let ((curve (get-nurbs-from-curve *geometry-kernel* (the native-curve-iw)))) (unless curve (warn "native-curve attempted from apparently null-pointer native-curve-iw~% Root-path is ~s~%" (the root-path))) curve)) ("GDL Curve object. The corresponding UV curve for the primary surface on which this curve lies, if any. If Loading Loading @@ -204,7 +209,9 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*." (make-array (length beziers) :initial-contents beziers))) (%lines-to-draw% (cond ((and (= (the degree) 1) (not (the rational?))) (%lines-to-draw% (when (the success?) (cond ((and (= (the degree) 1) (not (the rational?))) (let ((control-points (the b-spline-data))) (mapcar #'(lambda(start end) (list start end)) Loading @@ -214,15 +221,17 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*." (let ((points (the (equi-spaced-points (max 2 (floor (* (the total-length) ))))))) (mapcar #'list points (rest points)))) (t nil))) (t nil)))) (%curves-to-draw% (when (the success?) (unless (or *curve-tessellation?* (near-to? (the total-length) 0)) (if (typep self 'arc-curve) (call-next-method) (if (or (the %decomposed?%) (= (the %decomposed% curves number-of-elements) 1)) (if (or (the %decomposed?%) (= (the %decomposed% curves number-of-elements) 1)) (unless (and (= (the degree) 1) (not (the rational?))) (when (list-elements (the beziers)) (let (result) Loading @@ -235,14 +244,16 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*." (setq result (the-object bezier %curves-to-draw%)) (nconc result (the-object bezier %curves-to-draw%))))))) (append-elements (the %decomposed% curves) (the-element %curves-to-draw%)))))) (the-element %curves-to-draw%))))))) ;;(closed? (coincident-point? (the start) (the end) :tolerance (the closed-tolerance))) (closed? (coincident-point? (the start) (the end))) ("Boolean. This will be t if the curve is generated successfully, nil otherwise." success? (when (the native-curve) t)) success? (if (the native-curve) t ;; warn automatically returns nil (warn "Curve at ~s success? is nil" (the root-path)))) ("Number. The lowest parameter value of the underlying mathematical definition for this parametric curve" u-min (multiple-value-bind (min max) (the parameter-bounds) Loading surf/source/surface.lisp +7 −1 Original line number Diff line number Diff line Loading @@ -76,7 +76,13 @@ surface object, it does not make a copy)" (%schedule-finalization?% t) (native-surface (get-nurbs-from-surface *geometry-kernel* (the native-surface-iw))) (native-surface (let ((surface (get-nurbs-from-surface *geometry-kernel* (the native-surface-iw)))) (unless surface (error "native-surface attempted from apparently null-pointer native-surface-iw Root-path is ~s~%" (the root-path))) surface)) (native-pointer nil) Loading Loading
surf/source/brep.lisp +40 −12 Original line number Diff line number Diff line Loading @@ -366,21 +366,49 @@ of this brep. Exact supported format will be documented here when ready." ;; (local-box (the bounding-box)) (%native-faces% (get-faces-from-brep *geometry-kernel* (the %native-brep%))) (%native-edges% (get-edges-from-brep *geometry-kernel* (the %native-brep%))) (%native-regions% (get-regions-from-brep *geometry-kernel* (the %native-brep%))) (%native-shells% (get-shells-from-brep *geometry-kernel* (the %native-brep%))) (%native-vertices% (get-vertices-from-brep *geometry-kernel* (the %native-brep%))) (%native-faces% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-faces-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (%native-edges% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-edges-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (%native-regions% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-regions-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (%native-shells% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-shells-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (%native-vertices% (progn (assert (not (smlib::null-pointer-p (the %native-brep%)))) (let ((candidates (get-vertices-from-brep *geometry-kernel* (the %native-brep%)))) (mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates) candidates))) (faces-ht (let ((ht (make-hash-table :size (the faces number-of-elements)))) (dolist (face (list-elements (the faces)) ht) (setf (gethash (the-object face %native-face%) ht) face)))) ) (setf (gethash (the-object face %native-face%) ht) face))))) :objects Loading
surf/source/curve.lisp +31 −20 Original line number Diff line number Diff line Loading @@ -108,8 +108,13 @@ (%reversed?% nil) (%derivative?% nil) (native-curve (when (the native-curve-iw) (get-nurbs-from-curve *geometry-kernel* (the native-curve-iw)))) (native-curve (let ((curve (get-nurbs-from-curve *geometry-kernel* (the native-curve-iw)))) (unless curve (warn "native-curve attempted from apparently null-pointer native-curve-iw~% Root-path is ~s~%" (the root-path))) curve)) ("GDL Curve object. The corresponding UV curve for the primary surface on which this curve lies, if any. If Loading Loading @@ -204,7 +209,9 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*." (make-array (length beziers) :initial-contents beziers))) (%lines-to-draw% (cond ((and (= (the degree) 1) (not (the rational?))) (%lines-to-draw% (when (the success?) (cond ((and (= (the degree) 1) (not (the rational?))) (let ((control-points (the b-spline-data))) (mapcar #'(lambda(start end) (list start end)) Loading @@ -214,15 +221,17 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*." (let ((points (the (equi-spaced-points (max 2 (floor (* (the total-length) ))))))) (mapcar #'list points (rest points)))) (t nil))) (t nil)))) (%curves-to-draw% (when (the success?) (unless (or *curve-tessellation?* (near-to? (the total-length) 0)) (if (typep self 'arc-curve) (call-next-method) (if (or (the %decomposed?%) (= (the %decomposed% curves number-of-elements) 1)) (if (or (the %decomposed?%) (= (the %decomposed% curves number-of-elements) 1)) (unless (and (= (the degree) 1) (not (the rational?))) (when (list-elements (the beziers)) (let (result) Loading @@ -235,14 +244,16 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*." (setq result (the-object bezier %curves-to-draw%)) (nconc result (the-object bezier %curves-to-draw%))))))) (append-elements (the %decomposed% curves) (the-element %curves-to-draw%)))))) (the-element %curves-to-draw%))))))) ;;(closed? (coincident-point? (the start) (the end) :tolerance (the closed-tolerance))) (closed? (coincident-point? (the start) (the end))) ("Boolean. This will be t if the curve is generated successfully, nil otherwise." success? (when (the native-curve) t)) success? (if (the native-curve) t ;; warn automatically returns nil (warn "Curve at ~s success? is nil" (the root-path)))) ("Number. The lowest parameter value of the underlying mathematical definition for this parametric curve" u-min (multiple-value-bind (min max) (the parameter-bounds) Loading
surf/source/surface.lisp +7 −1 Original line number Diff line number Diff line Loading @@ -76,7 +76,13 @@ surface object, it does not make a copy)" (%schedule-finalization?% t) (native-surface (get-nurbs-from-surface *geometry-kernel* (the native-surface-iw))) (native-surface (let ((surface (get-nurbs-from-surface *geometry-kernel* (the native-surface-iw)))) (unless surface (error "native-surface attempted from apparently null-pointer native-surface-iw Root-path is ~s~%" (the root-path))) surface)) (native-pointer nil) Loading