home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / SEP93CAD.ZIP / TIP895.LSP < prev    next >
Lisp/Scheme  |  1993-08-31  |  2KB  |  77 lines
  1. ;TIP895:  GET.LSP    Get Properties   (C)1993, David Adie
  2.  
  3. (DEFUN C:GC (/ SS E N)
  4.    (PRINC "\n select entities for color change:")
  5.    (SETQ SS (SSGET))
  6.    (IF SS (PROGN
  7.          (SETQ E (CAR(ENTSEL "\n select new color <not bylayer>: ")))
  8.          (IF E (PROGN
  9.                (SETQ E (ENTGET E))
  10.                (SETQ N (CDR (ASSOC 62 E)))
  11.                (COMMAND "CHANGE" SS "" "PROP" "C" N "")
  12.          ))
  13.    ))
  14. )
  15. ;
  16. (defun C:GT (/ SS E N1 N2 N3)  
  17.    (princ "\n select text to alter: ")
  18.    (SETQ ss (ssget))
  19.    (IF ss (PROGN  
  20.          (SETQ E (car (entsel "\n pick text with desired qualities: ")))
  21.          (IF E (PROGN   
  22.                (SETQ E (ENTGET E)) 
  23.                (SETQ N1 (CDR (ASSOC 7 E)))  
  24.                (SETQ N2 (CDR (ASSOC 40 E)))
  25.          (SETQ N3 (CDR (ASSOC 8 E)))))  
  26.          (PROGN
  27.             (COMMAND "change" SS "" "" "" N1 N2 "" "" "")
  28.          (COMMAND "CHANGE" SS "" "P" "LA" N3 ""))
  29. )))
  30. ;
  31. (DEFUN C:GL (/ SS E N)
  32.    (PRINC "\n select entities for linetype change:")
  33.    (SETQ SS (SSGET))
  34.    (IF SS (PROGN
  35.          (SETQ E (CAR(ENTSEL "\n select new linetype <not bylayer>:")))
  36.          (IF E (PROGN
  37.                (SETQ E (ENTGET E))
  38.                (SETQ N (CDR (ASSOC 6 E)))
  39.                (COMMAND "CHANGE" SS "" "PROP" "LT" N "")
  40.          ))
  41.    ))
  42. )
  43. ;
  44. (DEFUN C:GSTR (/ SS E N)
  45.    (PRINC "\n select text string to change:")
  46.    (SETQ SS (SSGET))
  47.    (IF SS (PROGN
  48.          (SETQ E (CAR(ENTSEL "\n select string with desired content: ")))
  49.          (IF E (PROGN
  50.                (SETQ E (ENTGET E)) 
  51.                (SETQ N (CDR (ASSOC 1 E)))
  52.                (COMMAND "CHANGE" SS "" "" "" "" "" "" N)
  53.          ))
  54.    ))
  55. )
  56. ;
  57. (DEFUN C:LL (/ E N)
  58.    (SETQ E(CAR (ENTSEL "\n pick layer to lock: ")))
  59.    (if e nil (princ "\n try again homer:"))
  60.    (if e
  61.    (princ "\n layer locked thrasher:"))
  62.    (IF E (PROGN
  63.          (SETQ E (ENTGET E))
  64.          (SETQ N (CDR (ASSOC 8 E)))
  65. (COMMAND "LAYER" "lock" N ""))))
  66. ;
  67. (DEFUN C:LU (/ E N)
  68.    (SETQ E(CAR (ENTSEL "\n pick layer to unlock: ")))
  69.    (if e nil (princ "\n try again homer:"))
  70.    (if e
  71.    (princ "\n layer unlocked thrasher:"))
  72.    (IF E (PROGN
  73.          (SETQ E (ENTGET E))
  74.          (SETQ N (CDR (ASSOC 8 E)))
  75. (COMMAND "LAYER" "unlock" N ""))))
  76.  
  77.