Commit 59c6dc0c authored by Dave Cooper's avatar Dave Cooper

added spline support for DXF (apparently working now).

parent 802bcc2c
...@@ -124,52 +124,91 @@ ...@@ -124,52 +124,91 @@
((:wedge :double-wedge :triangle) ((:wedge :double-wedge :triangle)
;;(write-the line-thickness-setting) ;;(write-the line-thickness-setting)
;;(write-the rgb-stroke-setting) ;;(write-the rgb-stroke-setting)
(destructuring-bind (p0 p1 p2 p3) (let ((line-format-string " 0~%LINE~% 5~%~a~% 100~%AcDbEntity~% 100~%AcDbLine~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"))
(mapcar #'(lambda(point) (destructuring-bind (p0 p1 p2 p3)
(add-vectors *dxf-translation* (subseq point 0 2))) (mapcar #'(lambda(point)
(if view (mapcar #'(lambda(point) (the-object view (view-point point))) (the outline-points)) (add-vectors *dxf-translation* (subseq point 0 2)))
(the outline-points))) (if view (mapcar #'(lambda(point) (the-object view (view-point point))) (the outline-points))
(the outline-points)))
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p0) (get-y p0) (get-x p1) (get-y p1)) #+nil
(write-the line-thickness-setting) (format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(write-the rgb-stroke-setting) (get-x p0) (get-y p0) (get-x p1) (get-y p1))
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the line-thickness-setting) (format *stream* line-format-string (incf *dxf-entity-id*)
(write-the rgb-stroke-setting) (get-x p0) (get-y p0) (get-x p1) (get-y p1))
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(write-the line-thickness-setting) (write-the line-thickness-setting)
(write-the rgb-stroke-setting) (write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%" #+nil
(get-x p3) (get-y p3) (get-x p0) (get-y p0)) (format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(write-the line-thickness-setting) (get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the rgb-stroke-setting)) (format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting))
(when (the second-outline-points) (when (the second-outline-points)
(destructuring-bind (p0 p1 p2 p3) (destructuring-bind (p0 p1 p2 p3)
(mapcar #'(lambda(point) (mapcar #'(lambda(point)
(add-vectors *dxf-translation* (subseq point 0 2))) (add-vectors *dxf-translation* (subseq point 0 2)))
(if view (if view
(mapcar #'(lambda(point) (the-object view (view-point point))) (the second-outline-points)) (mapcar #'(lambda(point) (the-object view (view-point point))) (the second-outline-points))
(the second-outline-points))) (the second-outline-points)))
(write-the line-thickness-setting) (write-the line-thickness-setting)
(write-the rgb-stroke-setting) (write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p0) (get-y p0) (get-x p1) (get-y p1)) #+nil
(write-the line-thickness-setting) (format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(write-the rgb-stroke-setting) (get-x p0) (get-y p0) (get-x p1) (get-y p1))
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%" (format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p1) (get-y p1) (get-x p2) (get-y p2)) (get-x p0) (get-y p0) (get-x p1) (get-y p1))
(write-the line-thickness-setting) (write-the line-thickness-setting)
(write-the rgb-stroke-setting) (write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%" #+nil
(get-x p2) (get-y p2) (get-x p3) (get-y p3)) (format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(write-the line-thickness-setting) (get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the rgb-stroke-setting)
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p3) (get-y p3) (get-x p0) (get-y p0)) (format *stream* line-format-string (incf *dxf-entity-id*)
(write-the line-thickness-setting) (get-x p1) (get-y p1) (get-x p2) (get-y p2))
(write-the rgb-stroke-setting))))))))) (write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p2) (get-y p2) (get-x p3) (get-y p3))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting)
#+nil
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(format *stream* line-format-string (incf *dxf-entity-id*)
(get-x p3) (get-y p3) (get-x p0) (get-y p0))
(write-the line-thickness-setting)
(write-the rgb-stroke-setting))))))))))
...@@ -23,6 +23,8 @@ ...@@ -23,6 +23,8 @@
(defparameter *fixed-scale?* nil) (defparameter *fixed-scale?* nil)
(defparameter *dxf-entity-id* nil)
(eval-when (compile load eval) (export '*fixed-scale?*)) (eval-when (compile load eval) (export '*fixed-scale?*))
;; ;;
...@@ -32,7 +34,8 @@ ...@@ -32,7 +34,8 @@
(defmacro with-translated-state ((format center) &body body) (defmacro with-translated-state ((format center) &body body)
(ecase format (ecase format
(:pdf `(pdf:with-saved-state (pdf:translate (get-x ,center) (get-y ,center)) ,@body)) (:pdf `(pdf:with-saved-state (pdf:translate (get-x ,center) (get-y ,center)) ,@body))
(:dxf `(let ((*dxf-translation* (add-vectors (subseq ,center 0 2) *dxf-translation*))) ,@body)) (:dxf `(let ((*dxf-translation* (add-vectors (subseq ,center 0 2) *dxf-translation*)))
,@body))
(:raphael `(let ((*raphael-translation* (add-vectors (subseq ,center 0 2) *raphael-translation*))) ,@body)))) (:raphael `(let ((*raphael-translation* (add-vectors (subseq ,center 0 2) *raphael-translation*))) ,@body))))
...@@ -70,10 +73,11 @@ ...@@ -70,10 +73,11 @@
(with-translated-state (:pdf (make-point (- (get-x view-center)) (- (get-y view-center)))) (with-translated-state (:pdf (make-point (- (get-x view-center)) (- (get-y view-center))))
(write-the-object child-view cad-output)))))) (the views)))))))) (write-the-object child-view cad-output)))))) (the views))))))))
(define-lens (dxf base-drawing)() (define-lens (dxf base-drawing)()
:output-functions :output-functions
((cad-output () (mapc #'(lambda(view) (write-the-object view cad-output)) (the views))))) ((cad-output ()
(let ((*dxf-entity-id* 107))
(mapc #'(lambda(view) (write-the-object view cad-output)) (the views))))))
(define-lens (pdf base-view)() (define-lens (pdf base-view)()
...@@ -174,7 +178,6 @@ ...@@ -174,7 +178,6 @@
(dolist (item path-info) (dolist (item path-info)
(if (keywordp item) (if (keywordp item)
(progn (progn
(print-variables mode coords)
(when (and mode coords) (write-the (pdf-command mode (nreverse coords)))) (when (and mode coords) (write-the (pdf-command mode (nreverse coords))))
(setq mode item) (setq coords nil)) (setq mode item) (setq coords nil))
(push item coords))) (push item coords)))
...@@ -234,7 +237,8 @@ ...@@ -234,7 +237,8 @@
(mapc #'(lambda(line-index-pair) (mapc #'(lambda(line-index-pair)
(destructuring-bind (start-index end-index) line-index-pair (destructuring-bind (start-index end-index) line-index-pair
(let ((start (svref 2d-vertices start-index)) (end (svref 2d-vertices end-index))) (let ((start (svref 2d-vertices start-index)) (end (svref 2d-vertices end-index)))
(format *stream* " 0~%LINE~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%" (format *stream* " 0~%LINE~% 5~%~a~% 100~%AcDbEntity~% 100~%AcDbLine~% 10~%~3,16f~% 20~%~3,16f~% 11~%~3,16f~% 21~%~3,16f~%"
(incf *dxf-entity-id*)
(get-x start) (get-y start) (get-x end) (get-y end)))) (get-x start) (get-y start) (get-x end) (get-y end))))
(write-the object line-thickness-setting) (write-the object line-thickness-setting)
...@@ -243,7 +247,6 @@ ...@@ -243,7 +247,6 @@
line-index-pairs))) line-index-pairs)))
(mapc #'(lambda(curve) (mapc #'(lambda(curve)
(let ((control-points (mapcar #'(lambda(point) (add-vectors *dxf-translation* point)) (getf curve :control-points))) (let ((control-points (mapcar #'(lambda(point) (add-vectors *dxf-translation* point)) (getf curve :control-points)))
(knots (getf curve :knot-vector)) (knots (getf curve :knot-vector))
...@@ -256,10 +259,10 @@ ...@@ -256,10 +259,10 @@
" 0 " 0
SPLINE SPLINE
5
~a
100 100
AcDbEntity AcDbEntity
8
0
100 100
AcDbSpline AcDbSpline
210 210
...@@ -284,6 +287,7 @@ AcDbSpline ...@@ -284,6 +287,7 @@ AcDbSpline
0.0000001 0.0000001
~{ 40~%~,7f~^~%~} ~{ 40~%~,7f~^~%~}
~{~a~%~}" ~{~a~%~}"
(incf *dxf-entity-id*)
degree degree
(length knots) (length knots)
(length control-points) (length control-points)
...@@ -291,7 +295,13 @@ AcDbSpline ...@@ -291,7 +295,13 @@ AcDbSpline
(mapcar #'(lambda(point) (mapcar #'(lambda(point)
(format nil " 10~%~,7f~% 20~%~,7f~% 30~%0.0" (format nil " 10~%~,7f~% 20~%~,7f~% 30~%0.0"
(get-x point) (get-y point))) (get-x point) (get-y point)))
control-points)))) control-points))
(write-the object line-thickness-setting)
(write-the object dash-pattern-setting)
(write-the object rgb-stroke-setting)))
(the curves-2d-scaled)) (the curves-2d-scaled))
...@@ -401,8 +411,6 @@ AcDbSpline ...@@ -401,8 +411,6 @@ AcDbSpline
(read-byte image-stream nil nil))) (read-byte image-stream nil nil)))
((null val)) ((null val))
;;(print-variables *stream* val)
(write-byte val *stream*)))) (write-byte val *stream*))))
(delete-file temp-pdf) (delete-file temp-pdf)
......
This diff is collapsed.
...@@ -324,6 +324,12 @@ is specified), so it is necessary to explicitly give either start or center for ...@@ -324,6 +324,12 @@ is specified), so it is necessary to explicitly give either start or center for
(format *stream* " 0 (format *stream* " 0
TEXT TEXT
5
~a
100
AcDbEntity
100
AcDbText
10 10
~3,15f ~3,15f
20 20
...@@ -334,17 +340,17 @@ TEXT ...@@ -334,17 +340,17 @@ TEXT
~a~a ~a~a
41 41
~3,15f ~3,15f
7 100
~a AcDbText
" "
(incf *dxf-entity-id*)
(+ (get-x corner) (the dxf-offset)) (get-y corner) (* (the dxf-size-ratio) font-size) (+ (get-x corner) (the dxf-offset)) (get-y corner) (* (the dxf-size-ratio) font-size)
(the %text-to-draw%) (the %text-to-draw%)
(if (and rotation (not (zerop rotation))) (if (and rotation (not (zerop rotation)))
(format nil "~% 50~%~2,5f" rotation) "") (format nil "~% 50~%~2,5f" rotation) "")
(div (the dxf-text-x-scale) 100) (div (the dxf-text-x-scale) 100)
(the dxf-font) ;; (the dxf-font) ;; FLAG -- work the font back in.
) )
(write-the rgb-stroke-setting) (write-the rgb-stroke-setting)
......
...@@ -143,9 +143,12 @@ ...@@ -143,9 +143,12 @@
0))) 0)))
(declare (ignorable color-decimal)) (declare (ignorable color-decimal))
(format *stream* " 62~%~a~%" dxf-color-code) ;; FLAG -- work colors & layers back in.
(format *stream* " 8~%~a~%" dxf-layer-number) (unless (zerop dxf-color-code)
(format *stream* " 62~%~a~%" dxf-color-code))
(format *stream* " 8~%~a~%" (if (zerop dxf-layer-number) "Main" dxf-layer-number))
)) ))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment