Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Contribute to GitLab
Sign in / Register
Toggle navigation
G
gendl
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
45
Issues
45
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
gendl
gendl
Commits
2462c834
Commit
2462c834
authored
Aug 10, 2017
by
Dave Cooper
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
updated arc and arc-constraints for current prototype application.
parent
d87ad96b
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
197 additions
and
26 deletions
+197
-26
arc.lisp
geom-base/wire/source/arc.lisp
+10
-1
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