home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / jul93.zip / ROUGHEN.LSP < prev    next >
Lisp/Scheme  |  1993-06-21  |  3KB  |  95 lines
  1. ; ROUGHEN.LSP: Routine to "roughen" a polyline              15 May 93
  2. ; copyright 1993 by Mark Middlebrook / Daedalus Consulting
  3.  
  4. (defun C:ROUGHEN (/ basicziglen roughness en etype en1 en2 vtx1 vtx2
  5.                     seglen segang inclen zignum ziglen zigdist
  6.                     wanderdist wanderang newvtx seed)
  7.  
  8.    ;set desired length and roughness of "zigzags" here:  
  9.    (setq basicziglen (* 0.05 (getvar "DIMSCALE"))  ;larger is longer
  10.          roughness 0.25                            ;larger is rougher
  11.    )
  12.  
  13.    (setq ocmd (getvar "CMDECHO"))
  14.    (setvar "CMDECHO" 0)
  15.  
  16.    (setq en (car (entsel "\nSelect a Polyline or Line: "))
  17.          etype (cdr (assoc 0 (entget en)))
  18.    )
  19.  
  20.    (cond
  21.       ((equal etype "LINE")                     ;is entity a Line?
  22.          (command "._PEDIT" en "_Yes" "_eXit")  ;make it a Pline
  23.          (setq en (entlast)                     ;reset en
  24.                etype (cdr (assoc 0 (entget en)))
  25.          )
  26.       )
  27.    )
  28.  
  29.    (cond
  30.       ((equal etype "POLYLINE")                 ;is entity a Pline?
  31.          (setq en1 (entnext en)                    ;first vertex
  32.                en2 (entnext en1)                   ;second vertex
  33.          )
  34.          (command "._PEDIT" en "_Edit")            ;edit vertex
  35.  
  36.          (while (/= "SEQEND" (cdr (assoc 0 (entget en2))))
  37.             (setq vtx1 (cdr (assoc 10 (entget en1)))
  38.                   vtx2 (cdr (assoc 10 (entget en2)))
  39.                   seglen (distance vtx1 vtx2)
  40.                   segang (angle vtx1 vtx2)
  41.                   zignum (fix (/ seglen basicziglen)) ;# of "zigzags"...
  42.                   zignum (max zignum 2)               ; but not less than 2
  43.                   ziglen (/ seglen zignum)            ;zigzag length
  44.                   zigdist ziglen
  45.                   i 2
  46.             )
  47.  
  48.             (repeat (1- zignum)
  49.                (setq newvtx (polar vtx1 segang zigdist)  ;vertex init. loc.
  50.                      wanderdist (* roughness (randnum))
  51.                      wanderang (if (= (rem i 2) 1)       ;wander back & forth
  52.                                     (+ segang (/ pi 4))
  53.                                     (- segang (/ pi 4))
  54.                                );if
  55.                );setq
  56.                (command "_Insert" newvtx "_Next"
  57.                         "_Move" (polar newvtx wanderang wanderdist))
  58.                (setq zigdist (+ ziglen zigdist)
  59.                      i (1+ i)
  60.                )
  61.             );repeat
  62.  
  63.             (command "_Next")
  64.             (setq en1 en2
  65.                   en2 (entnext en1)
  66.             )
  67.          );while
  68.  
  69.          (command "_eXit" "_eXit")     ;exit PEDIT
  70.       );entity is a Pline
  71.  
  72.       (T (prompt "\nEntity is not a Polyline or Line."))
  73.    );cond
  74.  
  75.    (setvar "CMDECHO" ocmd)
  76.    (princ)
  77. );defun
  78.  
  79. ;Random number generation function - based on the linear
  80. ; congruential method as presented in Doug Cooper's book
  81. ; Condensed Pascal, pp. 116-117.
  82. ; Returns a random number between 0 and 1.
  83. (defun randnum ()
  84.    (if (not seed) (setq seed (getvar "DATE")))
  85.    (setq modulus 65536
  86.          multiplier 25173
  87.          increment 13849
  88.          seed (rem (+ (* multiplier seed) increment) modulus)
  89.          random (/ seed modulus)
  90.    )
  91. )
  92.  
  93. (prompt "\nROUGHEN loaded.  Type ROUGHEN to run it.")
  94. (princ)
  95.