;;
;;----------- convert spline(13 or 12) ------------;;
;;--------- to polyline with lines/arcs -----------;;
;;by Vladimir Nesterovsky ;;
;;  published on comp.cad.autocad in October 1996  ;;
;;
;;helper functions
(defun dxf(a b)(cdr(assoc a b)))
(defun sstol ( sel / l n )
 (if (= 'PICKSET (type sel))
   (repeat (setq n (sslength sel))
     (setq n (1- n) l (cons (ssname sel n) l))
)))
(defun substdxf (cod newval data / a)
  (setq a (assoc cod data))
  (if newval
    (if a
      (subst (cons cod newval) a data)         ;;replace
      (cons  (cons cod newval)   data) )       ;;prepend
    ;;(append data (list (cons cod newval))) ) ;;append
    (if a  ;;remove by Serge Volkov's idea from LISP PUZZLE on c.c.a
      (apply 'append (subst nil (list a) (mapcar 'list data)))
      data )))                                 ;;keep


;; convert spline13 to s-pline12 by control points
;; (w/out user fit points, so it's not good)
(defun spl13-12(e / d a p p1) ;; keep original entity
  (setq d (entget e))
  (setvar"cmdecho"0)(command"_pline")
  (foreach a d (if(= 10(car a)) ;;control points
    (command (if (null p1)
      (setq p1 (cdr a))(setq p (cdr a))))))
  (if (equal p p1)
    (command "c")
    (command ""))
  (command"_pedit""_l""_s""") )


;; command version
(defun c:spl13-12(/ e sel)
 (foreach e
   (if (setq sel (ssget "I" '((0 . "SPLINE")) ))
     (sstol sel)
     (sstol (ssget '((0 . "SPLINE")) )))
   (spl13-12 e) ))

;; convert splined 12'pline into regular Polyline
;; by Tony Tanzillo's advise - explode & join.
;; BAD: not always succeeds!
(defun despline12--(e)
  (setvar"cmdecho"0)(command "_explode" e)
  (command "_pedit" "_l" "_y" "_j" "_p" "" "") )

;; The same - by Lisp.
;; Use spline and curve fit points with their bulges.
;; If SPLINESEGS was negative when the pline was built,
;;   you'll get Arc segments, tangential to each other.
;; I guess this is how ACAD itself displays splined
;;   polylines.
;;this one makes pline by splinesgs setting
;;that was in effect when built
(defun despline12(e / e0 d) ;; erase original entity
  (setq d (entget (setq e0 e)))
  (if (and
    (= "POLYLINE" (dxf 0 d))
    (= 4 (logand 4 (dxf 70 d)))) ;;splined
  (progn
  (entmake (substdxf 70 (logand (~ 4)(dxf 70 d)) d))
  (WHILE (/= "SEQEND" (dxf 0
            (SETQ D (ENTGET (SETQ E (ENTNEXT E))))))
                    ;; spline and curve fit points
    (if (member (dxf 70 d) (list 8 1))
      (entmake      ;; use point and bulge data
        (substdxf 70 (logand (~ 9)(dxf 70 d)) d)) ))
  (entdel e0)
  (entmake '((0 . "SEQEND")))  )) (princ) )

;;this one makes pline by CURRENT splinesegs setting
(defun despline12c(e / e0 d) ;; don't keep original entity
  (setq d (entget (setq e0 e)))
  (if (and
    (= "POLYLINE" (dxf 0 d))
    (= 4 (logand 4 (dxf 70 d)))) ;;splined
  (progn
  (entmake (substdxf 70 (logand (~ 4)(dxf 70 d)) d))
  (WHILE (/= "SEQEND" (dxf 0
            (SETQ D (ENTGET (SETQ E (ENTNEXT E))))))
                    ;; control points
    (if (= 16 (logand (dxf 70 d) 16))
      (entmake      ;; use point and bulge data
        (substdxf 70 (logand (~ 16)(dxf 70 d)) d)) ))
  (entdel e0)
  (entmake '((0 . "SEQEND")))
  (command"_pedit""_l""_s""")
  (despline12 (entlast))
  )) (princ) )


;;command version
(defun c:despl12(/ e sel)
 (foreach e
   (if (setq sel (ssget "I" '((0 . "POLYLINE")) ))
     (sstol sel)
     (sstol (ssget '((0 . "POLYLINE")) )))
   (despline12 e)) )

;;the same, by current SPLINESEGS!!
(defun c:despl12c(/ e sel)
 (foreach e
   (if (setq sel (ssget "I" '((0 . "POLYLINE")) ))
     (sstol sel)
     (sstol (ssget '((0 . "POLYLINE")) )))
   (despline12c e)) )



;; FINALLY,
;; convert R13's SPLINE into arcs & lines' POLYLINE
(defun c:despl13(/ e sel)
  (foreach e
    (if (setq sel (ssget "I" '((0 . "SPLINE")) ))
      (sstol sel)
      (sstol (ssget '((0 . "SPLINE")) )))
    (spl13-12 e)
    (despline12 (entlast)) ))
;;-----------------10-19-96 04:24am---------------;;

(defun c:splin();; see control points and data points for SPLINE13

  (setq d (entget (setq e (car(sstol (ssget '((0 . "SPLINE"))))))))
  (setvar "cecolor" "10") ;;control points
  (command"pline")
  (foreach x d (if (= 10 (car x))(command(cdr x))))
  (command"")
  (setvar "cecolor" "11") ;;user data fit points
  (command"pline")
  (foreach x d (if (= 11 (car x))(command(cdr x))))
  (command"")
  (setvar "cecolor" "256")
  (princ)
)
Make your own free website on Tripod.com