home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / stmp_m.zip / STMP_ME.LSP < prev   
Encoding:
Text File  |  1993-07-08  |  8.4 KB  |  201 lines
  1. ;STMP_ME by Mark Evinger 73162,1676
  2. ;at Cowhey Gudmundson Leder, Ltd. Itasca, Illinois.
  3. ;=========================================================================
  4. ;Fm: Richard Halle [AVE TM] 73417,340
  5. ;=========================================================================
  6. (defun listxref ( / data work first)
  7.   (setq first t)                              ;set rewind flag
  8.   (while (setq data (tblnext "block" first))  ;rewind 1st time thru
  9.     (setq first nil)                          ;don't want to rewind anymore
  10.     (if (= 68 (logand 68 (cdr (assoc 70 data))))  ;XREFed >AND< ref'd Block?
  11.       (setq work (cons (cdr (assoc 2 data)) work));If "Yup", add name to list
  12.     )
  13.   )
  14.   work                                            ;returns the list
  15. )
  16. ;===========================================================================
  17. ;Fm: Mark Evinger 73162,1676 -> code modified from July 93 Cadalyst tip #881
  18. (defun datetime ()
  19.         (setq DATST (rtos (getvar "cdate") 2 16))
  20.         (setq HRS (atoi (substr DATST 10 2)))
  21.         (cond
  22.                 ((= HRS 00)
  23.                         (setq NHRS (itoa (+ HRS 12)))
  24.                         (setq XTR "a.m.")
  25.                 )
  26.                 ((< HRS 12)
  27.                         (setq NHRS (itoa HRS))
  28.                         (setq XTR "a.m.")
  29.                 )
  30.                 ((> HRS 12)
  31.                         (setq NHRS (itoa (- HRS 12)))
  32.                         (setq XTR "p.m.")
  33.                 )
  34.         )
  35.         (setq MO (substr DATST 5 2))
  36.                 (cond
  37.                         ((= MO "01")
  38.                                 (setq MONTH "January")
  39.                         )
  40.                         ((= MO "02")
  41.                                 (setq MONTH "February")
  42.                         )
  43.                         ((= MO "03")
  44.                                 (setq MONTH "March")
  45.                         )
  46.                         ((= MO "04")
  47.                                 (setq MONTH "April")
  48.                         )
  49.                         ((= MO "05")
  50.                                 (setq MONTH "May")
  51.                         )
  52.                         ((= MO "06")
  53.                                 (setq MONTH "June")
  54.                         )
  55.                         ((= MO "07")
  56.                                 (setq MONTH "July")
  57.                         )
  58.                         ((= MO "08")
  59.                                 (setq MONTH "August")
  60.                         )
  61.                         ((= MO "09")
  62.                                 (setq MONTH "September")
  63.                         )
  64.                         ((= MO "10")
  65.                                 (setq MONTH "October")
  66.                         )
  67.                         ((= MO "11")
  68.                                 (setq MONTH "November")
  69.                         )
  70.                         ((= MO "12")
  71.                                 (setq MONTH "December")
  72.                         )
  73.                 ); end MO cond
  74.         (setq DATE-STRING
  75.                 (strcat
  76.                         MONTH
  77.                         " "
  78.                         (substr DATST 7 2)","   ; day
  79.                         " "
  80.                         (substr DATST 1 4)      ; year
  81.                         " "
  82.                         NHRS                    ; hours
  83.                         ":"
  84.                         (substr DATST 12 2)     ; minutes
  85.                         ":"
  86.                         (substr DATST 14 2)     ; seconds
  87.                         " "
  88.                         XTR                     ; am/pm
  89.                 ); end strcat
  90.         ); end setq date-string
  91. ); end defun datetime
  92. ;=========================================================================
  93. (defun C:STMP_ME
  94.   (/ 
  95.     ip ips scaf sca rot rotn 
  96.     dwg data myxref xlist first ssa tdata tname ddata dname gdata gname 
  97.     xdata xname n
  98.   )
  99. ;_________________________________________________________________________
  100. ;
  101. ; Donald Pirl 71174,1113 Yamabe & Horn Engineering, Clovis, CA
  102. ; with appologies and due credit to:
  103. ;   Richard Henley 73260,2346 Scanlon and Associates, Albuquerque NM
  104. ;   Jason Osgood 73417,1756 Alacrity BBS (206) 746-0680, Bellevue WA
  105. ; Lisp Routine to Place Current Time, Date, Drawing Name and operator's 
  106. ; initials at selected location(s) and rotation (entered or picked).
  107. ; STMP.DWG accompanying this file must be in the ACAD path.
  108. ; Suggestions:  insert STMP.DWG in your prototype drawing,
  109. ;               include the command C:STMP in menu or keyboard save macros.
  110. ;       To include operator's initials, put the line 
  111. ;           set intl=XXX
  112. ;           (where XXX is the operator's initials)
  113. ;       in the autoexec.bat or acad.bat file
  114. ; Text will be L60 (.06") when plotting scale = stamp block insertion 
  115. ; scale, but the routine can be easily modified to suit.
  116. ;__________________________________________________________________________
  117. ;/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
  118. ;Revisions by ME... I wasn't happy with the way the time & date were
  119. ;       displayed in the original lisp (stmp.lsp), so I modified all
  120. ;       the things I needed to such that the time, date and  drawing
  121. ;       name are now displayed like this
  122. ;
  123. ;                       July 08, 1993 7:56:32 p.m.
  124. ;             Drawing: C:\DATA\ME1177\1177_P10.DWG
  125. ;               Xrefs: 1117.DWG 2436.DWG 2436A.DWG
  126. ;
  127. ;       The stmp.dwg has been modified so that all the attributes are
  128. ;       right-justified, and the block insertion point  is  the  text
  129. ;       insertion point of the drawing name. (Xrefs are not  normally
  130. ;       used in our drawings). This setup  allows  us  to  insert the
  131. ;       block so that it is right-justified in the  lower  right-hand
  132. ;       corner of our various border sheets.  The stmp_me.dwg will be
  133. ;    inserted on the current layer. One last addendum is the ever-
  134. ;       present menu modification code, use or discard as ya see fit!
  135. ;       
  136. ;       [STAMP_ME]^C^C^C(IF (not c:stmp_me);(LOAD "stmp_me"));stmp_me;
  137. ;
  138. ;    Good luck with this program, it was fun to edit it! ME
  139. ;/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
  140. ;==========================================================================
  141. ; Modifications by Mark Evinger 73162,1676 - with help from Richard Halle
  142. ;==========================================================================
  143.         (datetime)
  144.         (setq dt DATE-STRING)
  145.         (setq dt2 "")
  146.         (setq dwg 
  147.           (strcat "Drawing: " (strcase (getvar "dwgname"))".DWG")
  148.         )
  149.         (if (getenv "intl") (setq dwg "(" (strcase (getenv "intl"))")"))
  150.         (setq myxref (listxref))
  151.         (setq xlist (strcat "Xrefs: "))
  152.         (if (= myxref nil) (setq xlist (strcat " ")))
  153.         (mapcar
  154.           '(lambda (l)
  155.              (setq xlist (strcat xlist l ".DWG "))
  156.            )
  157.            myxref
  158.         )
  159. (if 
  160.     (setq ssa (ssget "X" '((0 . "INSERT") (2 . "STMP_ME"))))
  161.     (progn
  162.       (setq n (sslength ssa))
  163.       (while (> n 0)
  164.           (setq n (- n 1)
  165.                 tname (entnext (ssname ssa n))
  166.                 tdata (entget tname)
  167.                 dname (entnext tname)
  168.                 ddata (entget dname)
  169.                 gname (entnext dname)
  170.                 gdata (entget gname)
  171.                 xname (entnext gname)
  172.                 xdata (entget xname)
  173.                 tdata (subst (cons 1 dt2) (assoc 1 tdata) tdata)
  174.                 ddata (subst (cons 1 dt) (assoc 1 ddata) ddata)
  175.                 gdata (subst (cons 1 dwg) (assoc 1 gdata) gdata)
  176.                 xdata (subst (cons 1 xlist) (assoc 1 xdata) xdata)
  177.           )
  178.           (entmod tdata)
  179.           (entmod ddata)
  180.           (entmod gdata)
  181.           (entmod xdata)
  182.           (entupd gname)
  183.       )
  184.       (princ "\nStamp block(s) \"STMP_ME\" updated.\n")
  185.     )
  186.     (progn
  187.       (princ "\nSTMP_ME block not found - Now inserting.\n")
  188.       (setq ips (getpoint "\nInsertion point: <0.0,0.0,0.0> "))
  189.         (if (null ips) (setq ip (list 0.0 0.0 0.0)) (setq ip ips))
  190.       (setq scaf (getreal "\nScale factor: <1.0> "))
  191.          (if (null scaf) (setq sca "1.0") (setq sca scaf))
  192.       (setq rotn (getangle ip "\nEnter Text Rotation: <0.0> "))
  193.          (if (null rotn) (setq rot "0.0") (setq rot (angtos rotn 0 6)))
  194.       (command ".INSERT" "STMP_ME" 
  195.           ip sca sca rot dt2 dt dwg xlist)
  196.     )
  197.   )
  198.   (princ)
  199. )
  200. ; End Of File
  201.