home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / misc_lsp.zip / BLEND.LSP < prev    next >
Text File  |  1986-02-06  |  4KB  |  162 lines
  1. ;============================ P-SURF.LSP ================================
  2. ;
  3. ;  Patch surface routine for use with AutoCAD Version 2.6
  4. ;
  5. ;  Written by John Lynch   November, 1986
  6. ;
  7. ;  Modified by Ian Kitching to patch multiple lines May 20, 1987
  8. ;
  9. ;
  10. (defun C:BLEND ()
  11.   (setvar "cmdecho" 0)
  12.   (setvar "blipmode" 0)
  13. (setq add 0)
  14. (prompt "Select lines to surface\n")
  15.   (setq sset (ssget))
  16. (setq nrow (getint "\nEnter number of faces ALONG lines: "))
  17. (setq ncol (getint "\nEnter number of faces BETWEEN lines: "))
  18. (setq x 0) (setq fl 1) (setq mult nil)
  19. (setq test "3DLINE")
  20. (setq count 0) (setq ct 0)
  21. (while (/= count nil)
  22. (setq count (ssname sset ct))
  23. (setq ct (1+ ct))
  24. )
  25. (setq ct (1- ct))
  26. (princ ct) (princ " entities found\n")
  27.  (while (/= ct x)
  28.     (setq isit nil)
  29.       (if (/= mult nil) (progn
  30.               (while (/= test isit)
  31.                    (setq fl lsl)
  32.                    (setq sl (entget (ssname sset x)))
  33.                    (setq x (1+ x))
  34.                    (setq isit (cdr (assoc 0 sl))) 
  35.             )
  36.              (setq isit nil)
  37.            )
  38.       )
  39.       (if (= x 0) (progn
  40.                (while (/= test isit)   
  41.                    (setq fl (entget (ssname sset x)))
  42.                    (setq x (1+ x))
  43.                    (setq isit (cdr (assoc 0 fl)))
  44.                )
  45.                (setq isit nil)
  46.                    (while (/= test isit) 
  47.                    (setq sl (entget (ssname sset x)))
  48.                    (setq x (1+ x))
  49.                    (setq mult 1)
  50.                    (setq isit (cdr (assoc 0 sl)))
  51.                )
  52.              ) 
  53.       )
  54. (setq lfl fl) (setq lsl sl)
  55. (ptli)
  56. )
  57. (setvar "cmdecho" 1)
  58. (setvar "blipmode" 1)
  59. )
  60. ;
  61. ;Initilize the beginning points and determine the vecors along the lines.
  62. ;
  63. (defun ptli ()
  64.   (setq bp1 (cdr (assoc 10 fl))
  65.         ep1 (cdr (assoc 11 fl))
  66.         bp2 (cdr (assoc 10 sl))
  67.         ep2 (cdr (assoc 11 sl))
  68.         vl1 (vector ep1 bp1 nrow)
  69.         vl2 (vector ep2 bp2 nrow)
  70.         vpl1 (vector bp2 bp1 ncol)
  71.    )
  72. ;
  73. ;
  74. ;
  75.   (setq m 1)
  76.   (while (<= m nrow)
  77. ;
  78.      (setq
  79.         pl1 (vectadd bp1 vl1)
  80.         pl2 (vectadd bp2 vl2)
  81.         vpl2 (vector pl2 pl1 ncol)
  82.      )
  83. ;
  84. ;---- Initialize the face points
  85. ;
  86.      (setq lpp1 bp1
  87.            lpp2 pl1
  88.            n 1
  89.      )
  90. ;
  91. ;
  92.     (while (<= n ncol)
  93.       (setq upp1 (vectadd lpp1 vpl1)
  94.             upp2 (vectadd lpp2 vpl2)
  95.       )
  96.       (command "3dface" lpp1 lpp2 upp2 upp1 "")
  97.       (setq lpp1 upp1
  98.             lpp2 upp2
  99.             n (1+ n)
  100.       )
  101.     )
  102.  
  103.   (setq bp1 pl1
  104.         bp2 pl2
  105.         vpl1 vpl2
  106.         m (1+ m)
  107.    )
  108.   )
  109. )
  110.  
  111.  
  112. ;---------------------- VECTOR() -----------------------------
  113. ; Function to determine a vector between two point and divided by m.
  114. ;
  115. (defun vector (ep bp m / x1 x2 y1 y2 z1 z2 dx dy dz)
  116. ;
  117. ; bp : The beginnning point of the line.
  118. ; ep : The end point of the line.
  119. ; m  : The number of divisions in the line.
  120. ;
  121. ;
  122. ;
  123.   (setq x1 (car bp)
  124.         y1 (cadr bp)
  125.         z1 (caddr bp)
  126.   )
  127.   (setq x2 (car ep)
  128.         y2 (cadr ep)
  129.         z2 (caddr ep)
  130.   )
  131. ;
  132.   (setq dx (/ (- x2 x1) m)
  133.         dy (/ (- y2 y1) m)
  134.         dz (/ (- z2 z1) m)
  135.   )
  136.   (list dx dy dz)
  137. ;
  138. )
  139.  
  140. ;-----------------------------VECTADD() ------------------------------
  141. ;  Function to add a vector to a point.
  142. ;
  143. (defun vectadd(bp vec / x1 x2 y1 y2 z1 z2 dx dy dz)
  144. ;
  145. ; bp  : Beginning point assumed to be a list of three reals.
  146. ; vec : Vector to add to the point assumed to be the same.
  147.   (setq x1 (car bp)
  148.         y1 (cadr bp)
  149.         z1 (caddr bp)
  150.   )
  151.   (setq x2 (car vec)
  152.         y2 (cadr vec)
  153.         z2 (caddr vec)
  154.   )
  155. ;
  156.   (setq dx (+ x1 x2)
  157.         dy (+ y1 y2)
  158.         dz (+ z1 z2)
  159.   )
  160.   (list dx dy dz)
  161. )
  162.