home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p030 / 2.ddi / DRAWMAN.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-09-13  |  8.4 KB  |  272 lines
  1. ;
  2. ;       Drawing revision control - A programming example using entity handles.
  3. ;
  4. ;       This program implements a crude revision control system for drawings;
  5. ;       it is supplied purely as an illustration of what can be done using
  6. ;       handles and a very small amount of AutoLISP. It does not purport to 
  7. ;       be either a full-function drawing manager or the basis for 
  8. ;       implementing one.
  9. ;
  10. ;       The program requires the file REVINFO.DWG which it inserts as a block
  11. ;       with invisible attributes when the user logs out. All blocks are
  12. ;       inserted on layer $REV and become the reference for RLIST, FINGER, 
  13. ;       SELUSER, and SELECO. The revision information can then be referenced
  14. ;       when you log back on (i.e. LOGON).
  15. ;
  16. ;       Written by Kelvin R. Throop in December 1987
  17. ;
  18. ;
  19. ;       LOGON       - Log onto to drawing management system
  20. ;
  21. (defun C:LOGON ()
  22.         (if (= (getvar "HANDLES") 0)
  23.            (progn
  24.               (setvar "CMDECHO" 0)
  25.               (command "handles" "on")
  26.               (setvar "CMDECHO" 1)
  27.            )
  28.         )
  29.  
  30. ;       If user already logged on in this system, log him out
  31.  
  32.         (if usrnam
  33.            (C:logout)
  34.         )
  35.  
  36. ;       Obtain user identity information
  37.  
  38.         (setq usrnam (getstring T "Please enter your name: "))
  39.         (setq econum (getstring T "Engineering change order number: "))
  40.         (setq coment (getstring T "Comments: "))
  41.         (setq d (getvar "CDATE"))
  42.         (setq d (rtos d 2 0))
  43.         (setq rdate (strcat (substr d 3 2) "/" (substr d 5 2) "/"
  44.            (substr d 7 2)))
  45.         (setq d (entlast))
  46.         (if d
  47.            (setq fhandle (cdr (assoc 5 (entget d))))
  48.            (setq fhandle "0000000000000000")
  49.         )
  50.         (if (< (strlen fhandle) 16)
  51.            (setq fhandle (strcat (substr "0000000000000000"
  52.               1 (- 16 (strlen fhandle))) fhandle))
  53.         )
  54.         (setvar "CMDECHO" 0)
  55.         (command "undefine" "end")
  56.         (setvar "CMDECHO" 1)
  57.         (princ (strcat "Logged on as " usrnam))
  58.         (princ)
  59. )
  60.  
  61. ;       C:LOGOUT    - Add revision block at end of drawing session
  62.  
  63. (defun C:LOGOUT ()
  64.         (setq d (entlast))
  65.         (if d
  66.            (setq lhandle (cdr (assoc 5 (entget d))))
  67.            (setq lhandle "0000000000000000")
  68.         )
  69.         (if (< (strlen lhandle) 16)
  70.            (setq lhandle (strcat (substr "0000000000000000"
  71.               1 (- 16 (strlen lhandle))) lhandle))
  72.         )
  73.         (setq cl (getvar "CLAYER"))
  74.         (setvar "CMDECHO" 0)
  75.         (command "layer" "make" "$REV" "")
  76.         (command "insert" "revinfo" '(0 0) 1 1 0
  77.            usrnam econum coment rdate fhandle lhandle)
  78.         (command "layer" "set" cl "")
  79.         (setvar "CMDECHO" 1)
  80.         (setq usrnam nil)
  81.         (princ)
  82. )
  83.  
  84. ;       C:END       - Automatically log out user at end of session
  85.  
  86. (defun C:END ()
  87.         (if usrnam
  88.            (C:logout)
  89.         )
  90.         (command ".end")
  91. )
  92.  
  93. ;       C:RLIST     - List revision information
  94.  
  95. (defun C:RLIST ()
  96.         (setq s (ssget "X" '((8 . "$REV"))))
  97.         (setq i 0)
  98.         (while (setq e (ssname s i))
  99.            (setq i (1+ i))
  100.            (setq p T)
  101.            (setq lv nil)
  102.            (while p
  103.               (setq e (entnext e))
  104.               (setq ev (entget e))
  105.               (if (= "SEQEND" (cdr (assoc 0 ev)))
  106.                  (setq p nil)
  107.                  (setq lv (append lv (list (cdr (assoc 1 ev)))))
  108.               )
  109.            )
  110.            (princ (strcat "\nECO: " (cadr lv)
  111.               "   Changed by " (car lv) " on " (nth 3 lv)
  112.               ".  Comments: " (caddr lv)))
  113.         )
  114.         (princ)
  115. )
  116.  
  117. ;       C:FINGER    - Identify who changed an entity
  118.  
  119. (defun C:FINGER ()
  120.         (setq e (car (entsel)))              ; The entity
  121.         (if e
  122.            (progn
  123.               (setq h (cdr (assoc 5 (entget e))))  ; Its handle
  124.               (if (< (strlen h) 16)
  125.                  (setq h (strcat (substr "0000000000000000"
  126.                     1 (- 16 (strlen h))) h))
  127.               )
  128.               (setq s (ssget "X" '((8 . "$REV"))))
  129.               (setq i 0)
  130.               (setq found nil)
  131.               (while (and (null found) (setq e (ssname s i)))
  132.                  (setq i (1+ i))
  133.                  (setq p T)
  134.                  (setq lv nil)
  135.                  (while p
  136.                     (setq e (entnext e))
  137.                     (setq ev (entget e))
  138.                     (if (= "SEQEND" (cdr (assoc 0 ev)))
  139.                        (setq p nil)
  140.                        (setq lv (append lv (list (cdr (assoc 1 ev)))))
  141.                     )
  142.                  )
  143.                  (if (and (> h (nth 4 lv)) (<= h (nth 5 lv)))
  144.                     (setq found lv)
  145.                  )
  146.               )
  147.               (if found
  148.                  (princ (strcat "\nChanged by " (car found)
  149.                     " on " (nth 3 found) " ECO: " (cadr found)
  150.                     " Comments: " (caddr found)))
  151.                  (princ "\nCan't find creator of that entity.")
  152.               )
  153.            )
  154.         )
  155.         (setq s nil)
  156.         (princ)
  157. )
  158.  
  159. ;       INCHAND     - Increment handle (gasp!)
  160.  
  161. (defun inchand (s / i c os sv)
  162.         (setq os "")
  163.         (setq i 0)
  164.         (setq c 1)
  165.         (while (< i 16)
  166.            (setq i (1+ i))
  167.            (if (= c 1)
  168.               (progn
  169.                  (setq sv (substr s (strlen s)))
  170.                  (setq c 0)
  171.                  (cond
  172.                     ((= sv "9") (setq sv "A"))
  173.                     ((= sv "F") (setq sv "0" c 1))
  174.                     (t (setq sv (chr (1+ (ascii sv)))))
  175.                  )
  176.                  (setq os (strcat sv os))
  177.               )
  178.               (progn
  179.                  (setq os (strcat (substr s (strlen s)) os))
  180.               )
  181.            )
  182.            (setq s (substr s 1 (1- (strlen s))))
  183.         )
  184.         os
  185. )
  186.  
  187. ;       C:SELUSER   - Select entities added by user
  188.  
  189. (defun C:SELUSER ( / s n i e p lv ev h1 h2 he)
  190.         (setq s (ssget "X" '((8 . "$REV"))))
  191.         (setq n (strcase (getstring T "\nUser name: ")))
  192.         (setvar "CMDECHO" 0)
  193.         (command "select")
  194.         (setq i 0)
  195.         (while (setq e (ssname s i))
  196.            (setq i (1+ i))
  197.            (setq p T)
  198.            (setq lv nil)
  199.            (while p
  200.               (setq e (entnext e))
  201.               (setq ev (entget e))
  202.               (if (= "SEQEND" (cdr (assoc 0 ev)))
  203.                  (setq p nil)
  204.                  (setq lv (append lv (list (cdr (assoc 1 ev)))))
  205.               )
  206.            )
  207.            (if (= (strcase (car lv)) n)
  208.               (progn
  209.                  (setq h1 (inchand (nth 4 lv)))
  210.                  (setq h2 (nth 5 lv))
  211.                  (while (<= h1 h2)
  212.                     (if (setq he (handent h1))
  213.                        (command he)
  214.                     )
  215.                     (setq h1 (inchand h1))
  216.                  )
  217.               )
  218.            )
  219.         )
  220.         (setvar "CMDECHO" 1)
  221.         (getstring "Press any key to continue:")
  222.         (setvar "CMDECHO" 0)
  223.         (command "")
  224.         (setvar "CMDECHO" 1)
  225.         (setq s nil)
  226.         (princ)
  227. )
  228.  
  229. ;       C:SELECO   - Select entities by engineering change order
  230.  
  231. (defun C:SELECO ( / s n i e p lv ev h1 h2 he)
  232.         (setq s (ssget "X" '((8 . "$REV"))))
  233.         (setq n (strcase 
  234.            (getstring T "\nEngineering change order number: ")))
  235.         (setvar "CMDECHO" 0)
  236.         (command "select")
  237.         (setq i 0)
  238.         (while (setq e (ssname s i))
  239.            (setq i (1+ i))
  240.            (setq p T)
  241.            (setq lv nil)
  242.            (while p
  243.               (setq e (entnext e))
  244.               (setq ev (entget e))
  245.               (if (= "SEQEND" (cdr (assoc 0 ev)))
  246.                  (setq p nil)
  247.                  (setq lv (append lv (list (cdr (assoc 1 ev)))))
  248.               )
  249.            )
  250.            (if (= (strcase (cadr lv)) n)
  251.               (progn
  252.                  (setq h1 (inchand (nth 4 lv)))
  253.                  (setq h2 (nth 5 lv))
  254.                  (while (<= h1 h2)
  255.                     (if (setq he (handent h1))
  256.                        (command he)
  257.                     )
  258.                     (setq h1 (inchand h1))
  259.                  )
  260.               )
  261.            )
  262.         )
  263.         (setvar "CMDECHO" 1)
  264.         (getstring "Press any key to continue:")
  265.         (setvar "CMDECHO" 0)
  266.         (command "")
  267.         (setvar "CMDECHO" 1)
  268.         (setq s nil)
  269.         (princ)
  270. )
  271. (princ)
  272.