Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
134dc859
Commit
134dc859
authored
Jul 22, 2012
by
Dave Cooper
Browse files
started adding test color and strings to hw assembly output
parent
d4b9089b
Changes
7
Expand all
Hide whitespace changes
Inline
Side-by-side
regression/data/bracket.stp
View file @
134dc859
This diff is collapsed.
Click to expand it.
regression/source/b-spline-curve.lisp
View file @
134dc859
...
...
@@ -48,3 +48,36 @@
(
register-test-definition
'b-spline-curve-test
)
(
define-object
b-spline-curve-test-2
(
base-object
)
:input-slots
((
control-points
(
list
(
make-point
0
0
0
)
(
make-point
2
3.0
0.0
)
(
make-point
4
2.0
0.0
)
(
make-point
5
0.0
0.0
)
(
make-point
4
-2.0
0.0
)
(
make-point
2
-3.0
0.0
)
(
make-point
0
0
0
))))
:computed-slots
((
child-orientation
(
alignment
:rear
(
rotate-vector-d
(
the
(
face-normal-vector
:rear
))
45
(
the
(
face-normal-vector
:right
))))))
:objects
((
global-curve
:type
'b-spline-curve
:degree
1
:control-points
(
the
control-points
)
:orientation
(
the
child-orientation
))
(
local-curve
:type
'b-spline-curve
:degree
1
:local?
t
:control-points
(
the
control-points
)
:orientation
(
the
child-orientation
))))
regression/source/fitted-curve.lisp
View file @
134dc859
...
...
@@ -215,16 +215,45 @@
(
define-object
fitted-curve-test-4
(
fitted-curve
)
:input-slots
((
degree
1
))
:computed-slots
((
smooth-corners?
nil
)
;;(parameterization :chordlength)
(
degree
1
)
(
points
(
list
(
make-point
-1
-2
0
)
(
make-point
-1
2
0
)
(
make-point
1
2
0
)
(
make-point
1
-2
0
)
(
make-point
-1
-2
0
)))))
(
dolist
(
symbol
'
(
fitted-curve-test
fitted-curve-test-2
fitted-curve-test-3
fitted-curve-test-4
))
(
register-test-definition
symbol
))
(
define-object
fitted-curve-test-local-global
(
base-object
)
:computed-slots
((
child-orientation
(
alignment
:rear
(
rotate-vector-d
(
the
(
face-normal-vector
:rear
))
45
(
the
(
face-normal-vector
:right
))))))
:objects
((
local-degree-1
:type
'fitted-curve-test-4
:orientation
(
the
child-orientation
)
:local?
t
)
(
local-degree-3
:type
'fitted-curve-test-4
:orientation
(
the
child-orientation
)
:local?
t
:degree
3
)
(
global-degree-1
:type
'fitted-curve-test-4
:orientation
(
the
child-orientation
))
(
global-degree-3
:type
'fitted-curve-test-4
:orientation
(
the
child-orientation
)
:degree
3
)))
surf/source/b-spline-curve.lisp
View file @
134dc859
...
...
@@ -129,12 +129,17 @@ If any of the weights are different from 1.0, it is Rational."
Default is a value of 1.0 for each weight, resulting in a nonrational curve."
weights
(
make-list
(
length
(
the
control-points
))
:initial-element
1.0
))
(
"Boolean. Indicates whether the inputted control-points should be considered in local coordinate system of this object. Default is nil."
local?
nil
)
(
surface
nil
)
)
:computed-slots
((
native-curve
(
make-b-spline-curve
*geometry-kernel*
(
the
control-points
)
((
native-curve
(
make-b-spline-curve
*geometry-kernel*
(
if
(
the
local?
)
(
mapcar
#'
(
lambda
(
point
)
(
the
(
local-to-global
point
)))
(
the
control-points
))
(
the
control-points
))
(
mapcar
#'
to-double-float
(
the
weights
))
(
the
degree
)
(
the
knot-vector
)
))
...
...
surf/source/curve.lisp
View file @
134dc859
...
...
@@ -193,10 +193,11 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*."
(
%lines-to-draw%
(
cond
((
and
(
=
(
the
degree
)
1
)
(
not
(
the
rational?
)))
(
mapcar
#'
(
lambda
(
start
end
)
(
list
start
end
))
(
the
control-points
)
(
rest
(
the
control-points
))))
(
let
((
control-points
(
the
b-spline-data
)))
(
mapcar
#'
(
lambda
(
start
end
)
(
list
start
end
))
control-points
(
rest
control-points
))))
(
*curve-tessellation?*
(
let
((
points
(
the
(
equi-spaced-points
(
max
2
(
floor
(
*
(
the
total-length
)
)))))))
...
...
surf/source/fitted-curve.lisp
View file @
134dc859
...
...
@@ -85,10 +85,21 @@ A <tt>nil</tt> value indicates that no data reduction is to be attempted. Defaul
interpolant?
t
)
(
knot-multiplicity
:multiple
)
)
(
"Boolean. Indicates whether the inputted control-points should be considered in local coordinate system of this object. Default is nil."
local?
nil
))
:computed-slots
((
native-curve
((
effective-points
(
if
(
the
local?
)
(
mapcar
#'
(
lambda
(
point
)
(
the
(
local-to-global
point
)))
(
the
points
))
(
the
points
)))
(
effective-vectors
(
if
(
the
local?
)
(
mapcar
#'
(
lambda
(
vector
)
(
the
(
local-to-global
vector
)))
(
the
vectors
))
(
the
vectors
)))
(
native-curve
(
progn
(
when
(
and
(
the
vectors
)
(
member
(
the
vector-type
)
(
list
:tangents
:normals
))
...
...
@@ -104,7 +115,7 @@ A <tt>nil</tt> value indicates that no data reduction is to be attempted. Defaul
(
unless
degree-ok?
(
error
"The degree of a fitted-curve must be less than or equal to the number of control points."
))
(
interpolate-curve
*geometry-kernel*
(
the
points
)
(
the
degree
)
(
the
parameterization
)
:vectors
(
the
vectors
)
*geometry-kernel*
(
the
effective-
points
)
(
the
degree
)
(
the
parameterization
)
:vectors
(
the
effective-
vectors
)
:vector-type
(
the
vector-type
)
:interpolant?
(
the
interpolant?
)
:knot-multiplicity
(
the
knot-multiplicity
)
:tolerance
(
the
tolerance
)))
...
...
surf/source/views.lisp
View file @
134dc859
...
...
@@ -43,6 +43,7 @@
(
cad-output-assembly-tree
(
&optional
(
assembly-instance
(
let
((
assembly
(
make-assembly-instance
)))
(
set-format-slot
assembly
assembly
)
assembly
)))
(
dolist
(
child
(
the
children
))
(
if
(
the-object
child
children
)
;;
...
...
@@ -52,14 +53,11 @@
;; FLAG -- add object also in case there is actual geometry here.
;;
(
let
((
child-assembly-instance
(
make-assembly-instance
)))
(
write-the-object
child
(
cad-output-assembly-tree
child-assembly-instance
))
(
smlib::hwassembly-addsubassembly
(
smlib::hwstdautoptr-hwassemblyinstance-getassembly
assembly-instance
)
child-assembly-instance
)
)
child-assembly-instance
))
;;
;; Add objects
...
...
@@ -85,6 +83,13 @@
(
define-lens
(
nurbs
brep
)
()
:output-functions
((
cad-output-assembly
(
assembly-instance
)
(
smlib::iwaobject-addname
(
the
%native-brep%
)
(
smlib::iw-context
*geometry-kernel*
)
(
uffi:with-cstring
(
cstring
"hey now"
)
cstring
))
(
smlib::iwaobject-addcolor
(
the
%native-brep%
)
(
smlib::iw-context
*geometry-kernel*
)
1.0
0.0
0.0
)
(
smlib::hwassembly-addbrep
(
smlib::hwstdautoptr-hwassemblyinstance-getassembly
assembly-instance
)
(
the
%native-brep%
)))))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment