Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
64dc3961
Commit
64dc3961
authored
Apr 28, 2013
by
Dave Cooper
Browse files
Merge branch 'devo'
parents
667b987d
78d1a838
Changes
7
Hide whitespace changes
Inline
Side-by-side
geom-base/annotations/source/horizontal-dimension.lisp
View file @
64dc3961
...
...
@@ -51,6 +51,8 @@
:input-slots
(
(
base-plane-normal
(
the
(
face-normal-vector
:rear
)))
(
"3D Point. Determines where the text will start. Defaults to reasonable location for
horizontal-dimension."
dim-text-start
(
let
((
mid-point
(
translate-along-vector
...
...
@@ -72,7 +74,7 @@ horizontal-dimension."
(
+
(
the
leader-line-length
)
(
half
(
the
dimension-text
width
)))))
(
:end
(
translate
(
the
leader-end
)
(
if
(
the
start-end-swapped?
)
:
right
:lef
t
)
(
if
(
the
start-end-swapped?
)
:
left
:righ
t
)
(
+
(
half
(
the
dimension-text
width
))
(
the
leader-line-length-2
)))))))))
(
translate
center
:left
(
half
(
the
dimension-text
width
))
...
...
@@ -96,7 +98,7 @@ horizontal-dimension."
(
leader-direction-2-vector
(
the
(
face-normal-vector
(
if
(
the
start-end-swapped?
)
:left
:right
))))
(
base-plane-normal
(
the
(
face-normal-vector
:rear
)))
))
))
...
...
geom-base/annotations/source/leader-line.lisp
View file @
64dc3961
...
...
@@ -108,9 +108,7 @@ Currently only :wedge is supported. Default is :none."
:output-functions
((
cad-output
()
(
unless
(
typep
(
the
polyline
)
'null-part
)
(
write-the
polyline
(
cad-output
)))
(
mapc
#'
(
lambda
(
polyline
)
(
unless
(
typep
polyline
'null-part
)
(
write-the-object
polyline
cad-output
)))
...
...
geom-base/annotations/source/linear-dimension.lisp
View file @
64dc3961
...
...
@@ -228,6 +228,17 @@ and end-point."
(
3d-distance
(
the
end-point
)
intersect
)))
(
witness-line-overages
(
let
((
difference
(
-
(
the
start-base-distance
)
(
the
end-base-distance
))))
(
if
(
the
flip-leaders?
)
(
if
(
plusp
difference
)
(
list
:1
difference
:2
0
)
(
list
:1
0
:2
(
-
difference
)))
(
if
(
minusp
difference
)
(
list
:1
(
-
difference
)
:2
0
)
(
list
:1
0
:2
difference
)))))
#+
nil
(
witness-line-overages
(
let
((
difference
(
-
(
the
start-base-distance
)
(
the
end-base-distance
))))
(
if
(
the
flip-leaders?
)
...
...
geom-base/annotations/source/tests.lisp
View file @
64dc3961
...
...
@@ -29,6 +29,7 @@ NOTE: before compiling/loading this file, do:
|#
#+
nil
(
defun
run-tests
()
"Initiate all test in file"
(
ang
)
...
...
@@ -45,7 +46,7 @@ NOTE: before compiling/loading this file, do:
;;(draw3 'png)
)
#+
nil
(
define-object
vertical-0
(
base-object
)
:input-slots
((
length
1
)(
width
3
)(
height
0
)
(
character-size
0.125
))
...
...
@@ -70,7 +71,7 @@ NOTE: before compiling/loading this file, do:
:leader-line-length
0.5
:arrowhead-style
:triangle
)))
#+
nil
(
define-object
vertical-1-drawing
(
base-drawing
)
:objects
((
vert
:type
'vertical-dimension
...
...
@@ -94,7 +95,7 @@ NOTE: before compiling/loading this file, do:
(
the
vert
)
))))
#+
nil
(
define-object
vertical-1
(
base-object
)
:computed-slots
...
...
@@ -108,7 +109,7 @@ NOTE: before compiling/loading this file, do:
:pass-down
(
start-point
end-point
))))
#+
nil
(
define-object
vertical-2
(
base-object
)
:objects
...
...
@@ -124,6 +125,7 @@ NOTE: before compiling/loading this file, do:
:end-point
(
the
box
(
vertex
:top
:left
:rear
)))))
#+
nil
(
define-object
horizontal-1
(
base-object
)
:objects
...
...
@@ -137,7 +139,7 @@ NOTE: before compiling/loading this file, do:
:start-point
(
the
box
(
vertex
:top
:left
:rear
))
:end-point
(
the
box
(
vertex
:top
:right
:rear
)))))
#+
nil
(
define-object
par-1-draw
(
base-drawing
)
:objects
((
par
:type
'parallel-1
)
...
...
@@ -147,7 +149,7 @@ NOTE: before compiling/loading this file, do:
(
the
par
length-dimension
)
))))
#+
nil
(
define-object
parallel-1
(
base-object
)
:objects
...
...
@@ -164,7 +166,7 @@ NOTE: before compiling/loading this file, do:
:end-point
(
the
box
(
vertex
:top
:right
:rear
)))))
#+
nil
(
define-object
angular-1
(
base-drawing
)
:input-slots
...
...
@@ -231,16 +233,18 @@ NOTE: before compiling/loading this file, do:
:dim-angle-style
:degrees-minutes-seconds
:leader-radius
1.5
)))
#+
nil
(
defun
ang
()
(
with-format
(
pdf
"/tmp/ang-try.pdf"
)
(
write-the-object
(
make-object
'angular-1
)
cad-output
)))
#+
nil
(
defun
ang-dxf
()
(
with-format
(
dxf
"/tmp/ang-try.dxf"
)
(
write-the-object
(
make-object
'angular-1
)
cad-output
)))
#+
nil
(
define-object
test-matrix
(
base-object
)
:input-slots
((
length
(
half
792
))
(
width
612
)
...
...
@@ -429,20 +433,22 @@ NOTE: before compiling/loading this file, do:
#+
nil
(
defmethod
draw
((
format
(
eql
'dxf
)))
(
with-format
(
dxf
"/tmp/draw-try.dxf"
)
(
write-the-object
(
make-object
'busy-drawing
)
cad-output
)))
#+
nil
(
defmethod
draw
((
format
(
eql
'pdf
)))
(
with-format
(
pdf
"/tmp/draw-try.pdf"
)
(
write-the-object
(
make-object
'busy-drawing
)
cad-output
)))
#+
nil
(
defmethod
draw
((
format
(
eql
'png
)))
(
with-format
(
png
"/tmp/draw-try.png"
)
(
write-the-object
(
make-object
'busy-drawing
)
cad-output
)))
#+
nil
(
define-object
busy-drawing
(
base-drawing
)
:input-slots
...
...
@@ -466,7 +472,7 @@ NOTE: before compiling/loading this file, do:
(
with-format
(
dxf
"/tmp/try.dxf"
)
(
write-the-object
self
cad-output
)))))
#+
nil
(
define-object
container
(
gwl:web-drawing
)
:computed-slots
...
...
@@ -477,16 +483,17 @@ NOTE: before compiling/loading this file, do:
:objects
((
annotated-drawing
:type
'annotated-drawing
)))
#+
nil
(
defun
cont
()
(
with-format
(
pdf
"/tmp/cont-try.pdf"
)
(
write-the-object
(
make-object
'container
)
cad-output
)))
#+
nil
(
defun
contp
()
(
with-format
(
png
"/tmp/cont-try.png"
)
(
write-the-object
(
make-object
'container
)
cad-output
)))
#+
nil
(
define-object
annotated-drawing
(
base-drawing
)
:input-slots
((
page-length
700
)
(
page-width
800
))
...
...
@@ -566,7 +573,7 @@ NOTE: before compiling/loading this file, do:
:outside-leaders?
t
:character-size
15
)))
#+
nil
(
define-object
box-matrix
(
base-object
)
:objects
((
boxes
:type
'box
...
...
@@ -580,21 +587,23 @@ NOTE: before compiling/loading this file, do:
(
boxes-quantify-box
:type
'box
:height
0
)))
#+
nil
(
defmethod
draw2
((
format
(
eql
'dxf
)))
(
with-format
(
dxf
"/tmp/draw2-try.dxf"
)
(
write-the-object
(
make-object
'annotated-drawing
)
cad-output
)))
#+
nil
(
defmethod
draw2
((
format
(
eql
'pdf
)))
(
with-format
(
pdf
"/tmp/draw2-try.pdf"
:page-length
700
:page-width
800
)
(
write-the-object
(
make-object
'annotated-drawing
)
cad-output
)))
#+
nil
(
defmethod
draw2
((
format
(
eql
'png
)))
(
with-format
(
png
"/tmp/draw2-try.png"
:page-length
700
:page-width
800
)
(
write-the-object
(
make-object
'annotated-drawing
)
cad-output
)))
#+
nil
(
define-object
robot-web
(
gwl:web-drawing
)
:input-slots
((
page-length
700
)
(
page-width
900
))
...
...
@@ -608,7 +617,7 @@ NOTE: before compiling/loading this file, do:
((
robot
:type
'robot:assembly
)))
#+
nil
(
define-object
robot-drawing
(
base-drawing
)
:input-slots
((
page-length
792
)
(
page-width
612
))
...
...
@@ -625,25 +634,25 @@ NOTE: before compiling/loading this file, do:
(
robot
:type
'robot:assembly
)))
#+
nil
(
defmethod
draw3
((
format
(
eql
'dxf
)))
(
with-format
(
dxf
"/tmp/draw3-try.dxf"
)
(
write-the-object
(
make-object
'robot-drawing
)
cad-output
)))
#+
nil
(
defmethod
draw3
((
format
(
eql
'pdf
)))
(
let
((
self
(
make-object
'robot-drawing
)))
(
with-format
(
pdf
"/tmp/draw3-try.pdf"
:page-length
(
the
page-length
)
:page-width
(
the
page-width
))
(
write-the
cad-output
))))
#+
nil
(
defmethod
draw3
((
format
(
eql
'png
)))
(
let
((
self
(
make-object
'robot-drawing
)))
(
with-format
(
png
"/tmp/draw3-try.png"
)
(
write-the
cad-output
))))
#+
nil
(
define-object
box-with-drawing
(
base-object
)
:objects
...
...
@@ -657,6 +666,7 @@ NOTE: before compiling/loading this file, do:
(
box
:type
'box
:length
10
:width
20
:height
30
)))
#+
nil
(
define-object
dimensioned-drawing
(
base-drawing
)
:input-slots
(
objects
)
...
...
@@ -666,7 +676,7 @@ NOTE: before compiling/loading this file, do:
:objects
(
the
objects
))))
#+
nil
(
define-object
box-with-two-viewed-drawing
(
base-object
)
:objects
...
...
@@ -680,6 +690,7 @@ NOTE: before compiling/loading this file, do:
(
box
:type
'box
:length
10
:width
20
:height
30
)))
#+
nil
(
define-object
two-viewed-drawing
(
base-drawing
)
:input-slots
(
objects
)
...
...
@@ -707,6 +718,7 @@ NOTE: before compiling/loading this file, do:
(
box
:type
'box
:length
10
:width
20
:height
30
)))
(
define-object
box-annotated-drawing
(
base-drawing
)
:input-slots
(
objects
(
character-size
15
)
(
witness-line-gap
10
)
...
...
@@ -714,7 +726,7 @@ NOTE: before compiling/loading this file, do:
(
witness-line-ext
5
))
:objects
((
main
-view
:type
'base-view
((
tri
-view
:type
'base-view
:projection-vector
(
getf
*standard-views*
:trimetric
)
:length
(
half
(
the
length
))
:center
(
translate
(
the
center
)
:rear
(
half
(
the-child
length
)))
...
...
@@ -724,31 +736,31 @@ NOTE: before compiling/loading this file, do:
(
main-length-dim
:type
'vertical-dimension
:pass-down
(
character-size
witness-line-gap
witness-line-length
witness-line-ext
)
:start-point
(
the
main
-view
(
view-point
(
the
box
(
vertex
:rear
:top
:right
))))
:end-point
(
the
main
-view
(
view-point
(
the
box
(
vertex
:rear
:bottom
:right
))))
:start-point
(
the
tri
-view
(
view-point
(
the
box
(
vertex
:rear
:top
:right
))))
:end-point
(
the
tri
-view
(
view-point
(
the
box
(
vertex
:rear
:bottom
:right
))))
:dim-value
(
3d-distance
(
the
box
(
vertex
:rear
:top
:right
))
(
the
box
(
vertex
:rear
:bottom
:right
)))
:text-above-leader?
nil
)
(
top
-view
:type
'base-view
:projection-vector
(
getf
*standard-views*
:front
)
:length
(
half
(
the
length
))
:center
(
translate
(
the
center
)
:front
(
half
(
the-child
length
)))
:objects
(
the
objects
)
:annotation-objects
(
list
(
the
top-length-dim
)))
(
front
-view
:type
'base-view
:projection-vector
(
getf
*standard-views*
:front
)
:length
(
half
(
the
length
))
:center
(
translate
(
the
center
)
:front
(
half
(
the-child
length
)))
:objects
(
the
objects
)
:annotation-objects
(
list
(
the
top-length-dim
)))
(
top-length-dim
:type
'vertical-dimension
:pass-down
(
character-size
witness-line-gap
witness-line-length
witness-line-ext
)
:start-point
(
the
top
-view
(
view-point
(
the
box
(
vertex
:rear
:top
:right
))))
:dim-scale
(
/
(
the
top
-view
view-scale
))
:start-point
(
the
front
-view
(
view-point
(
the
box
(
vertex
:rear
:top
:right
))))
:dim-scale
(
/
(
the
front
-view
view-scale
))
:text-above-leader?
nil
:end-point
(
the
top-view
(
view-point
(
the
box
(
vertex
:rear
:bottom
:right
)))))))
:end-point
(
the
front-view
(
view-point
(
the
box
(
vertex
:rear
:bottom
:right
)))))))
#+
nil
(
define-object
box-with-immune-dimension
(
base-object
)
:objects
...
...
@@ -758,6 +770,7 @@ NOTE: before compiling/loading this file, do:
(
box
:type
'box
:length
10
:width
20
:height
30
)))
#+
nil
(
define-object
immune-dimension-drawing
(
base-drawing
)
:input-slots
(
objects
(
character-size
20
)
(
witness-line-gap
10
)
...
...
geom-base/annotations/source/vertical-dimension.lisp
View file @
64dc3961
...
...
@@ -73,7 +73,11 @@ horizontal-dimension."
((
and
(
not
(
the
outside-leaders?
))
(
the
text-above-leader?
)
(
not
(
the
text-along-axis?
)))
(
translate
mid-point
:left
(
half
(
the
dimension-text
width
))))
;;(translate mid-point :left (half (the dimension-text width)))
mid-point
)
((
and
(
not
(
the
outside-leaders?
))
(
not
(
the
text-above-leader?
))
(
not
(
the
text-along-axis?
)))
...
...
geom-base/drawing/source/base-view.lisp
View file @
64dc3961
...
...
@@ -345,10 +345,11 @@ the box should be facing. Defaults to <tt>*nominal-y-vector*</tt>."
(
annotation-caches
:type
'view-object-cache
:sequence
(
:size
(
length
(
the
annotation-array
)))
:projection-vector
(
getf
*standard-views*
:top
)
;;:view-transform :top
:view-transform
(
view-transform
:top
:snap-to
(
the
snap-to
))
:snap-to
(
the
snap-to
)
:snap-to-y?
(
coincident-point?
(
the
snap-to
)
*nominal-y-vector*
)
:view-transform
(
view-transform
:top
)
;;:view-transform (view-transform :top :snap-to (the snap-to))
;;:snap-to (the snap-to)
;;:snap-to-y? (coincident-point? (the snap-to) *nominal-y-vector*)
:snap-to-y?
nil
:scale?
nil
:object
(
svref
(
the
annotation-array
)
(
the-child
index
)))
...
...
system-index.txt
View file @
64dc3961
gendl.asd
gwl
\
gwl.asd
base
\
base.asd
surf
\
surf.asd
glisp
\
glisp.asd
apps
\
ta2
\
ta2.asd
demos
\
bus
\
bus.asd
apps
\
tree
\
tree.asd
apps
\
yadd
\
yadd.asd
cl-lite
\
cl-lite.asd
apps
\
tasty
\
tasty.asd
demos
\
robot
\
robot.asd
demos
\
ledger
\
ledger.asd
geom-base
\
geom-base.asd
regression
\
regression.asd
gwl-graphics
\
gwl-graphics.asd
demos
\
wire-world
\
wire-world.asd
apps
\
translators
\
translators.asd
documentation
\
training
\
g102-tud
\
examples
\
examples.asd
gendl.asd
gwl
/
gwl.asd
base
/
base.asd
surf
/
surf.asd
glisp
/
glisp.asd
apps
/
ta2
/
ta2.asd
demos
/
bus
/
bus.asd
apps
/
tree
/
tree.asd
apps
/
yadd
/
yadd.asd
cl-lite
/
cl-lite.asd
apps
/
tasty
/
tasty.asd
demos
/
robot
/
robot.asd
demos
/
ledger
/
ledger.asd
geom-base
/
geom-base.asd
regression
/
regression.asd
gwl-graphics
/
gwl-graphics.asd
demos
/
wire-world
/
wire-world.asd
apps
/
translators
/
translators.asd
documentation
/
training
/
g102-tud
/
examples
/
examples.asd
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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