Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
gendl
gendl
Commits
2462c834
Commit
2462c834
authored
Aug 10, 2017
by
Dave Cooper
Browse files
updated arc and arc-constraints for current prototype application.
parent
d87ad96b
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
197 additions
and
26 deletions
+197
-26
geom-base/wire/source/arc.lisp
geom-base/wire/source/arc.lisp
+10
-1
geom-base/wire/source/line-and-arc-constraints.lisp
geom-base/wire/source/line-and-arc-constraints.lisp
+187
-25
No files found.
geom-base/wire/source/arc.lisp
View file @
2462c834
...
...
@@ -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?
)))))
...
...
geom-base/wire/source/line-and-arc-constraints.lisp
View file @
2462c834
...
...
@@ -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
...
...
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