home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_SPLN.LSP < prev    next >
Lisp/Scheme  |  1996-10-02  |  9KB  |  265 lines
  1. ;;; FLX_SPLN.LSP
  2. ;;; ===========================================================
  3. ;;; (C)opyright: Felix Computer Aided Technologies GmbH 1995-96
  4. ;;; Created:     June 29, 1996 / vp
  5. ;;; Modified:    Sept 29, 1996 / vp
  6. ;;; ===========================================================
  7. ;;; Commands: SPLINE, PCURVE
  8. ;;; ===========================================================
  9.  
  10. (defun FLX_SPLINE ( / prt_list tmp fn e1 e2 i1)
  11.  
  12.   (defun *ERROR* (msg / msg)
  13.      (if (or (= msg "User break")
  14.              (= msg "Abbruch durch den Nutzer")
  15.          ) 
  16.         (princ)
  17.         (princ msg)
  18.      )
  19.      (setq *error* nil)
  20.      (if fn (XUNLOAD fn))
  21.   )
  22.  
  23.   ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  24.   ;;; Prompt List
  25.  
  26.   (setq prt_list (list
  27.        "File not found: \n"
  28.        "Alert" 
  29.        "Decurve" 
  30.        "Select polyline to alter to B-spline: "
  31.        "Select B-spline to decurve: "
  32.        "No entity selected!"
  33.        "No polyline selected!" 
  34.        "Number of segments for approximation (2 to 1024)" 
  35.        "Number for appoximation must be greater than 1!\n"
  36.        "Number for appoximation must be less than 1024!\n" 
  37.   ))
  38.   (if FLX_XLANGUAGE (FLX_XLANGUAGE "_spln" "_spline"))
  39.  
  40.   ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  41.  
  42.   (if POLY2BSPLINE
  43.      (setq tmp T)
  44.      (if (setq tmp (findfile (setq fn (strcat FLX$DIRECTORY "fl_stup.dll"))))
  45.          (XLOAD tmp)
  46.          (ALERT
  47.             (strcat (nth 0 prt_list) fn) ;@File not found: \n
  48.             (nth 1 prt_list) ;@Alert 
  49.             "EXCLAMATION"
  50.          )
  51.      )
  52.   )
  53.   ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  54.   (if tmp (progn
  55.     (setq tmp nil)
  56.     (initget 256 (nth 2 prt_list)) ;@Decurve
  57.     (setq e1 (entsel (nth 3 prt_list))) ;@Select polyline to alter to B-spline: 
  58.     (if (eq (type e1) 'STR) 
  59.        (if (or (= (substr e1 1 1) (substr (nth 2 prt_list) 1 1) )
  60.               (= (substr e1 1 2) (strcat "_" (substr (nth 2 prt_list) 1 1)) )
  61.         )
  62.         (progn   ;@Decurve
  63.           (setq e1 nil)
  64.           (setq e2 (entsel (nth 4 prt_list))) ;@Select B-spline to decurve: 
  65.         )
  66.       )
  67.     )
  68.     (if (or e1 e2)
  69.       (princ)
  70.       (princ (nth 5 prt_list)) ;@No entity selected!
  71.     )
  72.     (if (and e2 (= (type (car e2)) 'ENAME))
  73.       (if (= (cdr (assoc 0 (entget (car e2)))) "POLYLINE") ;;;### type
  74.         (BSPLINE2POLY (car e2))
  75.         (princ (nth 6 prt_list)) ;@No polyline selected!
  76.       )
  77.     )
  78.     (if (and e1 (= (type (car e1)) 'ENAME))
  79.       (if (= (cdr (assoc 0 (entget (car e1)))) "POLYLINE")
  80.         (progn
  81.           (if (not FLX$SPLINESEGMENTS) (setq FLX$SPLINESEGMENTS 8))
  82.           (setq i1 1)
  83.           (while (< i1 2)
  84.              (initget (+ 2 4 256) "8")
  85.              (setq i1 (getint (strcat
  86.                (nth 7 prt_list) ;@Number of segments for approximation (2 to 1024)"
  87.                " <"
  88.                (itoa FLX$SPLINESEGMENTS)
  89.                ">: "
  90.              )))
  91.              (cond
  92.                ((not i1)
  93.                 (setq i1 FLX$SPLINESEGMENTS)
  94.                )
  95.                ((= i1 "8")
  96.                 (setq i1 8)
  97.                )
  98.                ((= i1 1)
  99.                 (princ
  100.                  (nth 8 prt_list) ;@Number for appoximation must be greater than 1!\n
  101.                 )
  102.                )
  103.               ((> i1 1024)
  104.                (princ
  105.                 (nth 9 prt_list) ;@Number for appoximation must be less than 1024!\n
  106.                )
  107.                (setq i1 1)
  108.               )
  109.              ) ; cond
  110.            ) ; while
  111.            (setq FLX$SPLINESEGMENTS i1)
  112.            (POLY2BSPLINE (car e1) FLX$SPLINESEGMENTS)
  113.         )
  114.         (princ (nth 6 prt_list)) ;@No polyline selected!
  115.       )
  116.     ) 
  117.   )) 
  118.   (if fn (XUNLOAD fn))
  119.   (setq *error* nil)
  120.   (princ)
  121. )
  122. (princ)
  123.  
  124. ;;; ================================================================
  125. ;;; PCURVE
  126.  
  127. (defun FLX_PCURVE ( / prt_list tmp fn e1 e2 i1)
  128.  
  129.   (defun *ERROR* (msg / msg)
  130.      (if (or (= msg "User break")
  131.             (= msg "Abbruch durch den Nutzer")
  132.          ) 
  133.         (princ)
  134.         (princ msg)
  135.      )
  136.      (setq *error* nil)
  137.      (if fn (XUNLOAD fn))
  138.   )
  139.   ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  140.   (setq prt_list (list
  141.        "File not found: \n" ;0
  142.        "Alert" ;1
  143.        "Decurve" ;2
  144.        "Select 2D-polyline to alter to curved polyline: " ;3
  145.        "Select curved polyline to decurve: " ;4
  146.        "No entity selected!" ;5
  147.        "No polyline selected!" ;6
  148.        "Number of steps for interpolation points (0...6)" ;7
  149.        "Number of steps must be between 0 through 6!\n" ;8
  150.        "Tension (0.0 ... 1.0)" ;9
  151.        "Value for tension must be between 0.0 and 1.0!\n" ;10
  152.        "No polyline selected!" ;11
  153.        "3D polyline or 3D mesh can not be altered to curved polyline!" ;12
  154.   )) 
  155.   (if FLX_XLANGUAGE (FLX_XLANGUAGE "_spln" "_pcurve"))
  156.   ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  157.  
  158.   (if POLY2CATROM_2D
  159.      (setq tmp T)
  160.      (if (setq tmp (findfile (setq fn (strcat FLX$DIRECTORY "fl_stup.dll"))))
  161.          (XLOAD tmp)
  162.          (ALERT
  163.             (strcat (nth 0 prt_list) fn) ;@File not found: \n
  164.             (nth 1 prt_list) ;@Alert 
  165.             "EXCLAMATION"
  166.          )
  167.      )
  168.   )
  169.   ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  170.   (if tmp (progn
  171.     (setq tmp nil)
  172.     (initget 256 (nth 2 prt_list)) ;@Decurve
  173.     (setq e1 (entsel (nth 3 prt_list))) ;@Select 2D-polyline to alter to curved polyline: 
  174.     (if (eq (type e1) 'STR)
  175.       (if (or (= (substr e1 1 1) (substr (nth 2 prt_list) 1 1) )
  176.               (= (substr e1 1 2) (strcat "_" (substr (nth 2 prt_list) 1 1)) )
  177.           )
  178.         (progn   ;;;Decurve
  179.           (setq e1 nil)
  180.           (setq e2 (entsel (nth 4 prt_list))) ;@Select curved polyline to decurve: 
  181.         )
  182.       )
  183.     )
  184.     (if (or e1 e2)
  185.       (princ)
  186.       (princ (nth 5 prt_list)) ;@No entity selected!
  187.     )
  188.     (if (and e2 (= (type (car e2)) 'ENAME))
  189.       (if (= (cdr (assoc 0 (entget (car e2)))) "POLYLINE") ;;;### type
  190.         (CATROM2POLY_2D (car e2))
  191.         (princ (nth 6 prt_list)) ;@No polyline selected!
  192.       )
  193.     )
  194.     (if (and e1 (= (type (car e1)) 'ENAME))
  195.       (if (= (cdr (assoc 0 (entget (car e1)))) "POLYLINE")
  196.         (progn
  197.           (if (not FLX$PCURVESTEPS) (setq FLX$PCURVESTEPS 3))
  198.           (setq i1 -1)
  199.           (while (< i1 0)
  200.              (initget (+ 4 256) "3")
  201.              (setq i1 (getint (strcat
  202.                (nth 7 prt_list) ;@Number of steps for interpolation points (0 ... 6)
  203.                " <"
  204.                (itoa FLX$PCURVESTEPS)
  205.                ">: "
  206.              )))
  207.              (cond
  208.                ((not i1)
  209.                 (setq i1 FLX$PCURVESTEPS)
  210.                )
  211.               ((= i1 "3")
  212.                 (setq i1 3)
  213.                )
  214.                ((or (< i1 0)(> i1 6))
  215.                 (princ
  216.                  (nth 8 prt_list) ;@Number of steps must be between 0 through 6!\n
  217.                 )
  218.                )
  219.              ) ; cond
  220.           ) ; while
  221.           (setq FLX$PCURVESTEPS i1)
  222.           ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  223.           ;;; Get value for tension
  224.           (if (not FLX$PCURVETENSION) (setq FLX$PCURVETENSION 0.5))
  225.           (setq i1 -1)
  226.           (while (< i1 0.00)
  227.              (initget (+ 2 256) "0.5")
  228.              (setq i1 (getreal (strcat
  229.                (nth 9 prt_list) ;@Tension (0.0 ... 1.0)
  230.                " <"
  231.                (rtos FLX$PCURVETENSION 2)
  232.                ">: "
  233.              )))
  234.              (cond
  235.                ((not i1)
  236.                 (setq i1 FLX$PCURVETENSION)
  237.                )
  238.                ((=  i1 "0.5")
  239.                 (setq i1 0.5)
  240.                )
  241.                ((or (< i1 0.00)(> i1 1.00))
  242.                 (princ
  243.                  (nth 10 prt_list) ;@Value for tension must be between 0.0 and 1.0!\n
  244.                 )
  245.                )
  246.              ) ; cond
  247.            ) ; while
  248.            (setq FLX$PCURVETENSION i1)
  249.            ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  250.            ;;; Create catmull-rom curve
  251.            (if (null (POLY2CATROM_2D (car e1) FLX$PCURVESTEPS FLX$PCURVETENSION))
  252.                (princ (nth 12 prt_list)) ;;;@3D polyline or 3D mesh can not be altered to curved polyline!
  253.            )
  254.         )
  255.         (princ (nth 11 prt_list)) ;@No polyline selected!
  256.       )
  257.     ) 
  258.   )) 
  259.   (if fn (XUNLOAD fn))
  260.   (setq *error* nil)
  261.   (princ)
  262. )
  263.  
  264. (princ)
  265.