;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
;;; Copyright © 2012-2020 by Reinaldo N. Togores. All rights reserved.
;;; Use of this code is allowed mentioning the book and its author.
;;;Chapter 14. NURBS curves: The Spline entity.
(defun ax-spline (point-list / start-tg end-tg points arr-pts)
(setq start-tg (vlax-3d-point '(0 0 0))
end-tg (vlax-3d-point '(0 0 0))
points (apply 'append point-list)
arr-pts (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length points))))
arr-pts (vlax-safearray-fill arr-pts points))
(vla-AddSpline
(current-space *aevl:drawing*)
arr-pts
start-tg
end-tg))
;;;Listing 14.1. Function that creates a SPLINE entity applying the AddSpline method.
(defun ent-spline-FP (point-list)
(entmake
(append
(list '(0 . "SPLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbSpline")
'(71 . 3)
(cons 74 (length point-list)))
(mapcar '(lambda (x) (cons 11 x)) point-list))))
;;;Listing 14.2. Function for creating a Fit Points Spline.
(defun knot-vector (cv degree clamped / number center vector i)
(setq number (+ degree cv 1)
degree (if clamped
(1+ degree)
degree)
center (- number (* degree 2))
i 0)
(repeat degree (setq vector (cons 0 vector)))
(repeat center
(setq i (1+ i))
(setq vector (cons i vector)))
(repeat degree (setq vector (cons (1+ i) vector)))
(reverse vector))
;;;Listing 14.3. Function that creates the Knot Vector.
(defun ent-spline-CV (vertices-list degree clamped / cv k-vec)
(setq cv (length vertices-list)
k-vec (knot-vector cv degree clamped))
(entmake
(append
(list '(0 . "SPLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbSpline")
(cons 71 degree)
(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)) vertices-list))))
;;;Listing 14.4. Function that creates a Spline by the control vertices method.
(defun cv-helix (center base-radius top-radius height resolution turns twist /
n-ver ang incang incrad val-z f-rad rad-v vertex vertices)
(setq turn-height (/ (float height) (* turns resolution))
n-ver (* turns resolution)
incang (/ pi (/ resolution 2.0))
incrad (/
(float (- top-radius base-radius))
(* turns resolution))
ang (- 0.0 incang)
val-z (- (nth 2 center) (/ turn-height 2))
f-rad (cos (/ pi resolution))
rad-v (- (/ base-radius f-rad) incrad))
(repeat (+ n-ver 2)
(setq vertex (polar center ang rad-v)
vertex (list (nth 0 vertex) (nth 1 vertex) val-z)
vertices (cons vertex vertices)
ang (if (= twist 1)
(+ ang incang)
(- ang incang))
rad-v (+ rad-v incrad)
val-z (+ val-z turn-height)))
(reverse vertices))
;;;Listing 14.5. Cálculo de los vértices de control para la hélice.
(defun ent-helix-CV (point-list degree clamped base-center base-radius
top-radius turns turn-height twist / cv k-vec)
(setq cv (length point-list)
k-vec (knot-vector cv degree clamped))
(entmake
(append
(list '(0 . "HELIX")
'(100 . "AcDbEntity")
'(100 . "AcDbSpline")
(cons 71 degree)
(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)) point-list)
(list '(100 . "AcDbHelix")
(cons 10 base-center)
(cons 11 (polar base-center 0.0 base-radius))
'(12 0.0 0.0 1.0)
(cons 40 top-radius)
(cons 41 turns)
(cons 42 turn-height)
(cons 290 twist)
(cons 280 1)))))
;;;Listing 14.5. Function that computes the helix's control vertices coordinates.
(defun spline-helix-data (/)
(initget 1)
(setq base-center (getpoint "\nBase center: "))
(initget (+ 1 2 4))
(setq base-radius (getdist base-center "\nBase radius: "))
(initget (+ 1 2 4))
(setq top-radius (getdist base-center "\nTop radius: "))
(initget (+ 1 2 4))
(setq height (getdist base-center "\nHelix height: "))
(initget (+ 1 2 4))
(setq turns (getint "\nNumber of turns: "))
(initget "CW CCW")
(setq twist (getkword "\nTwist direction [CW/CCW] :"))
(if (or (null twist) (= twist "CCW"))
(setq twist 1)
(setq twist 0))
(initget (+ 1 2 4))
(setq resolution (getint "\nVertices for each turn: ")))
;;;Listing 14.7. Helix data input function.
(defun C:ENT-HELIX (/ base-center base-radius top-radius height resolution turns
twist vertices-list)
(spline-helix-data)
(setq vertices-list (cv-helix base-center base-radius top-radius height
resolution turns twist))
(ent-helix-CV vertices-list 3 nil base-center base-radius top-radius turns
turn-height twist)
(princ))
No comments:
Post a Comment