;;;Código fuente del libro "Experto AutoCAD con Visual LISP"
;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
;;; (c) 2012-2020 Reinaldo Togores. Todos los derechos reservados
;;; Se permite su uso mencionando la obra y su autor.
;;;Capítulo 14: La entidad Spline
(defun ax-spline (lista-puntos / tg-ini tg-fin puntos matriz-pts)
(setq tg-ini (vlax-3d-point '(0 0 0))
tg-fin (vlax-3d-point '(0 0 0))
puntos (apply 'append lista-puntos)
matriz-pts (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length puntos))))
matriz-pts (vlax-safearray-fill matriz-pts puntos))
(vla-AddSpline
(espacio-actual *aevl:dibujo*)
matriz-pts
tg-ini
tg-fin))
;;;Listado 14.1. Función que crea una entidad SPLINE aplicando el método AddSpline.
(defun ent-spline-FP (lista-puntos)
(entmake
(append
(list '(0 . "SPLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbSpline")
'(71 . 3)
(cons 74 (length lista-puntos)))
(mapcar '(lambda (x) (cons 11 x)) lista-puntos))))
;;;Listado 14.2. Función que crea una Spline por Puntos de Ajuste.
(defun vector-nudos (vc grado sujeta / numero centro vector i)
(setq numero (+ grado vc 1)
grado (if sujeta
(1+ grado)
grado)
centro (- numero (* grado 2))
i 0)
(repeat grado (setq vector (cons 0 vector)))
(repeat centro
(setq i (1+ i))
(setq vector (cons i vector)))
(repeat grado (setq vector (cons (1+ i) vector)))
(reverse vector))
;;;Listado 14.3. Función que crea el vector de nudos.
(defun ent-spline-VC (lista-puntos grado sujeta / vc k-vec)
(setq vc (length lista-puntos)
k-vec (vector-nudos vc grado sujeta))
(entmake
(append
(list '(0 . "SPLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbSpline")
(cons 71 grado)
(cons 72 (length k-vec))
(cons 73 vc)
'(74 . 0)
'(42 . 0.0000001)
'(43 . 0.0000001))
(mapcar '(lambda (k) (cons 40 k)) k-vec)
(mapcar '(lambda (x) (cons 10 x)) lista-puntos))))
;;;Listado 14.4. Función que crea una Spline por el método de Vértices de Control.
(defun vc-helice (centro radio-base radio-sup altura resolucion vueltas torsion /
n-ver ang incang incrad ang val-z f-rad rad-v vertice vertices)
(setq paso (/ (float altura) (* vueltas resolucion))
n-ver (* vueltas resolucion)
incang (/ pi (/ resolucion 2.0))
incrad (/
(float (- radio-sup radio-base))
(* vueltas resolucion))
ang (- 0.0 incang)
val-z (- (nth 2 centro) (/ paso 2))
f-rad (cos (/ pi resolucion))
rad-v (- (/ radio-base f-rad) incrad))
(repeat (+ n-ver 2)
(setq vertice (polar centro ang rad-v)
vertice (list (nth 0 vertice) (nth 1 vertice) val-z)
vertices (cons vertice vertices)
ang (if (= torsion 1)
(+ ang incang)
(- ang incang))
rad-v (+ rad-v incrad)
val-z (+ val-z paso)))
(reverse vertices))
;;;Listado 14.5. Cálculo de los vértices de control para la hélice.
(defun ent-helix-VC (lista-puntos grado sujeta centro-base radio-base radio-sup
vueltas paso torsion / cv k-vec)
(setq cv (length lista-puntos)
k-vec (vector-nudos cv grado sujeta))
(entmake
(append
(list '(0 . "HELIX")
'(100 . "AcDbEntity")
'(100 . "AcDbSpline")
(cons 71 grado)
(cons 72 (length k-vec))
(cons 73 cv)
'(74 . 0)
'(42 . 0.0000001)
'(43 . 0.0000001))
(mapcar '(lambda (k) (cons 40 k)) k-vec)
(mapcar '(lambda (x) (cons 10 x)) lista-puntos)
(list '(100 . "AcDbHelix")
(cons 10 centro-base)
(cons 11 (polar centro-base 0.0 radio-base))
'(12 0.0 0.0 1.0)
(cons 40 radio-sup)
(cons 41 vueltas)
(cons 42 paso)
(cons 290 torsion)
(cons 280 1)))))
;;;Listado 14.6. Función que crea una entidad HELIX mediante entmake.
(defun datos-spline-helice (/)
(initget 1)
(setq centro-base (getpoint "\nCentro de la Base: "))
(initget (+ 1 2 4))
(setq radio-base (getdist centro-base "\nRadio de la Base: "))
(initget (+ 1 2 4))
(setq radio-sup (getdist centro-base "\nRadio Superior: "))
(initget (+ 1 2 4))
(setq altura (getdist centro-base "\nAltura de la Hélice: "))
(initget (+ 1 2 4))
(setq vueltas (getint "\nNúmero de vueltas: "))
(initget "Horaria Antihoraria")
(setq torsion (getkword "\nSentido de torsión [Horaria/Antihoraria] <Antihoraria>:" ))
(if (or (null torsion) (= torsion "Antihoraria"))
(setq torsion 1)
(setq torsion 0))
(initget (+ 1 2 4))
(setq resolucion (getint "\nNúmero de vértices para cada vuelta: ")))
;;;Listado 14.7. Función de entrada de datos para la Hélice.
(defun C:ENT-HELICE (/ centro-base radio-base radio-sup altura resolucion vueltas
torsion lista-puntos)
(datos-spline-helice)
(setq lista-puntos (vc-helice centro-base radio-base radio-sup altura resolucion
vueltas torsion))
(ent-helix-VC lista-puntos 3 nil centro-base radio-base radio-sup vueltas paso
torsion)
(princ))
;;;Listado 14.8. Función principal C:ENT-HELIX
(defun helix->spline (ename /)
(cond
((entmake
(subst '(0 . "SPLINE")
'(0 . "HELIX")
(reverse
(cdr
(member '(100 . "AcDbHelix")
(reverse (entget ename)))))))
(entdel ename)
(entlast))))
;;;Listado 14.9. Conversión de una entidad HELIX en una SPLINE.
