Author Topic: [help] About Fourier transform  (Read 1466 times)

0 Members and 1 Guest are viewing this topic.

chlh_jd

  • Guest
[help] About Fourier transform
« on: April 10, 2014, 12:05:36 PM »
Hi all master .
I want use Fourier transform method to quick rebuild any closed curves , but I don't know how to Use Fast Fourier transform method .
Thank you for your enthusiastic guide .

here's I wrote .
Code - Auto/Visual Lisp: [Select]
  1. ;; 傅里叶转换因子 Fourier transform factor .
  2. (defun fourier   (pl / xl yl N i j k kl)
  3.   (setq xl (mapcar 'car pl)
  4.         yl (mapcar 'cadr pl)
  5.         N  (length xl) 
  6.         i  0)
  7.   (repeat N
  8.     (setq j -1)
  9.     (setq k (apply
  10.               'mapcar
  11.               (cons
  12.                 '+
  13.                 (mapcar (function
  14.                           (lambda (x y)
  15.                             (setq j (1+ j))
  16.                             (list (+ (* x (cos (/ (* 2. pi i j) N)))
  17.                                      (* y (sin (/ (* 2. pi i j) N))))
  18.                                   (- (* y (cos (/ (* 2. pi i j) N)))
  19.                                      (* x (sin (/ (* 2. pi i j) N)))
  20.                                      ))))
  21.                         xl
  22.                         yl)))
  23.           k (pt* k (1/ N)))
  24.     (setq kl (cons k kl)
  25.           i  (1+ i)))
  26.   (reverse kl)
  27.   )
  28.  
Test command
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test  (/ pl kl N i j p)
  2.   (setq pl (LM:Entity->PointList (car (entsel "\nSelect a closed curve :"))))
  3.   (setq kl (fourier pl))
  4.   (princ kl)
  5.   (setq N  (length pl) 
  6.         i  0
  7.         pl nil)
  8.   ;; rebuild curve
  9.   (repeat N
  10.     (setq j -1)
  11.     (setq p
  12.            (apply
  13.              'mapcar
  14.              (cons
  15.                '+
  16.                (mapcar (function
  17.                          (lambda (k)
  18.                            (setq j (1+ j))
  19.                            (ixi k
  20.                                 (list (cos (/ (* 2. pi i j) N))
  21.                                       (- (sin (/ (* 2. pi i j) N)))))))
  22.                        kl))))
  23.     (setq pl (cons p pl))
  24.     (setq i (1+ i)))
  25.   (setq pl (reverse pl))
  26.     (append
  27.       (list (cons 0 "LWPOLYLINE")
  28.         (cons 100  "AcDbEntity")           
  29.         (cons 100  "AcDbPolyline")
  30.             (cons 90 (length pl)))      
  31.       (mapcar (function (lambda (x) (cons 10 x))) pl)                          
  32.       (list (cons 70 1) (cons 62 1))))  
  33.   (princ)
  34.   )
  35.  
Used Function
Code - Auto/Visual Lisp: [Select]
  1. ;;-------------------------------------------------------------------------
  2. ;; 复数相乘  Plural Multiplication
  3. (defun ixi  (a b)
  4.   (list (- (* (car a) (car b)) (* (cadr a) (cadr b)))
  5.         (+ (* (car a) (cadr b)) (* (car b) (cadr a))))
  6.   )
  7. ;;欧拉公式 Euler's formula : e^±ix=cosx±isinx  e^iπ+1=0
  8. (defun eix  (x)
  9.   (list (cos x) (sin x)))
  10. ;------------------------------------------------------------;;
  11. ;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
  12. ;;------------------------------------------------------------;;
  13. ;;  Arguments:                                                ;;
  14. ;;  ent - Entity for which to return Point List.              ;;
  15. ;;------------------------------------------------------------;;
  16. ;;  Returns:  List of Points describing/approximating entity  ;;
  17. ;;------------------------------------------------------------;;
  18. (defun LM:Entity->PointList ( ent / der di1 di2 di3 elst fun inc lst par rad )
  19.     (setq elst (entget ent))
  20.     (cond
  21.         (   (eq "POINT" (cdr (assoc 0 elst)))
  22.             (list (cdr (assoc 10 elst)))
  23.         )
  24.         (   (eq "LINE" (cdr (assoc 0 elst)))
  25.             (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
  26.         )
  27.         (   (member (cdr (assoc 0 elst)) (list "CIRCLE" "ARC"))
  28.             (setq di1 0.0
  29.                   di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
  30.                   inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
  31.                   fun (if (vlax-curve-isclosed ent) < <=)
  32.             )
  33.             (while (fun di1 di2)
  34.                 (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  35.                       di1 (+ di1 inc)
  36.                 )
  37.             )
  38.             lst
  39.         )
  40.         (   (or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
  41.                 (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80)))
  42.             )
  43.             (setq par 0)
  44.             (repeat (fix (1+ (vlax-curve-getendparam ent)))
  45.                 (if (setq der (vlax-curve-getsecondderiv ent par))
  46.                     (if (equal der (list 0.0 0.0 0.0) 1e-8)
  47.                         (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
  48.                         (if (setq rad (distance (list 0.0 0.0) (vlax-curve-getfirstderiv ent par))
  49.                                   di1 (vlax-curve-getdistatparam ent par)
  50.                                   di2 (vlax-curve-getdistatparam ent (1+ par))
  51.                             )
  52.                             (progn
  53.                                 (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
  54.                                 (while (< di1 di2)
  55.                                     (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  56.                                           di1 (+ di1 inc)
  57.                                     )
  58.                                 )
  59.                             )
  60.                         )
  61.                     )
  62.                 )
  63.                 (setq par (1+ par))
  64.             )
  65.             (if (or (vlax-curve-isclosed ent) (equal (list 0.0 0.0 0.0) der 1e-8))
  66.                 lst
  67.                 (cons (vlax-curve-getendpoint ent) lst)
  68.             )
  69.         )
  70.         (   (eq (cdr (assoc 0 elst)) "ELLIPSE")
  71.             (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
  72.                   di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  73.                   di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))))
  74.             )
  75.             (while (< di1 di2)
  76.                 (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  77.                       der (distance (list 0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1)))
  78.                       di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
  79.                 )
  80.             )
  81.             (if (vlax-curve-isclosed ent)
  82.                 lst
  83.                 (cons (vlax-curve-getendpoint ent) lst)
  84.             )
  85.         )
  86.         (   (eq (cdr (assoc 0 elst)) "SPLINE")
  87.             (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
  88.                   di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  89.                   inc (/ di2 25.0)
  90.             )
  91.             (while (< di1 di2)
  92.                 (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  93.                       der (/ (distance (list 0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1))) inc)
  94.                       di1 (+ di1 (if (equal 0.0 der 1e-10) inc (min inc (/ 1.0 der (* 10. inc)))))
  95.                 )
  96.             )
  97.             (if (vlax-curve-isclosed ent)
  98.                 lst
  99.                 (cons (vlax-curve-getendpoint ent) lst)
  100.             )
  101.         )
  102.     )
  103. )
  104.  
« Last Edit: April 10, 2014, 12:12:18 PM by chlh_jd »