chg lsp

;;; -*-  Mode: LISP -*- Syntax: AutoLISP (C) Benjamin Olasov 1988, 1989
;;; Entity edit function C:CHG
;;; Displays and modifies the properties of individual entities.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File: CHG.LSP Copyright (C) Benjamin Olasov 1989 All Rights Reserved    ;;;
;;; Research/ commercial/ support inquiries:                                ;;;
;;;       Benjamin Olasov  236 East 28th Street   New York, NY  10025       ;;;
;;;                        PH (212) 725-4617                                ;;;
;;;                        MCI-Mail:  344-4003                              ;;;
;;;                        Arpanet Mailstop: olasov @ cs.columbia.edu       ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This program is provided 'as is' without warranty of any kind, either
;; expressed or implied, including, but not limited to the implied warranties of
;; merchantability and fitness for a particular purpose.  The entire risk as to
;; the quality and performance of the program is with the user.  Should the
;; program prove defective, the user assumes the entire cost of all necessary
;; servicing, repair or correction.
;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CHG displays and modifies the properties of individual entities.          ;;
;;                                                                           ;;
;; CHG creates a numbered menu of the selected entities properties, and      ;;
;; then prompts the user to select the number of the property to modify.     ;;
;; CHG then prompts for a new value for that property, which may be a        ;;
;; point (list), real, integer, or string.                                   ;;
;;                                                                           ;;
;; Any changes made by CHG can be undone using AutoCad's 'U' command.        ;;
;; Doing so will return the drawing to its state before using CHG.           ;;
;;                                                                           ;;
;; A random example of using CHG:                                            ;;
;; In a drawing containing two valid blocks A and B, an individual           ;;
;; iteration of block A can be transformed to an iteration of block B by     ;;
;; giving B as its new name. All of its previous insertion parameters will   ;;
;; remain the same, but its identity will be changed to block B. If the      ;;
;; name of the layer in which the entity resides is changed to the name of   ;;
;; an existing layer, the entity will change its residence to that layer.    ;;
;; However, if the new layer name is the name of a non-existing layer, a     ;;
;; layer with that name will be created, and the entity will be transferred  ;;
;; to that layer.                                                            ;;
;;                                                                           ;;
;; Syntax: CHG                                                               ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(gc)
(vmon)
(princ "\nLoading- please wait.. -")

(defun descriptor (key e_type)
       (cond ((null key) nil)
             ((= key -1) "ENTITY NAME <RO>")
             ((= key 0) "ENTITY TYPE")
             ((= key 1) "TEXT VALUE")
             ((and (= key 2)
                   (= e_type "ATTDEF")) "ATTRIBUTE TAG")
             ((and (= key 2)
                   (= e_type "INSERT")) "BLOCK NAME")
             ((= key 2) "NAME")
             ((or (= key 3)
                  (= key 4)) "OTHER NAME VALUES")
             ((= key 5) "HANDLE <RO>")
             ((= key 6) "LINETYPE NAME <RO>")
             ((= key 7) "TEXT STYLE NAME <RO>")
             ((= key 8) "LAYER")
             ((= key 9) "VARIABLE NAME IDENTIFIER")
             ((and (= key 10)
                   (= e_type "INSERT")) "INSERTION BASE")
             ((= key 10) "ORIGIN POINT")
             ((and (>= key 11)
                   (<= key 18)) "OTHER POINT COORDINATE")
             ((= key 20) "PRIMARY Y COORDINATE")
             ((and (>= key 21) (<= key 28)) "OTHER Y COORDINATE")
             ((and (>= key 31) (<= key 36)) "OTHER Z COORDINATE")
             ((= key 38) "ELEVATION")
             ((= key 39) "THICKNESS")
             ((and (>= key 40)
                   (<= key 48)
                   (or (= e_type "CIRCLE")
                       (= e_type "ARC"))) "RADIUS")
             ((and (>= key 40)
                   (<= key 75)
                   (= e_type "POLYLINE")) (pline_handler key ent))
             ((and (>= key 40)
                   (<= key 72)
                   (or (= e_type "TEXT")
                       (= e_type "ATTDEF"))) (text_handler key ent))
             ((and (= key 41)
                   (= e_type "INSERT")) "X SCALE FACTOR")
             ((and (= key 42)
                   (= e_type "INSERT")) "Y SCALE FACTOR")
             ((and (= key 43)
                   (= e_type "INSERT")) "Z SCALE FACTOR")
             ((and (>= key 40)
                   (<= key 48)) "FLOATING POINT VALUE")
             ((= key 49) "REPEATED VALUE")
             ((and (>= key 50)
                   (<= key 58)) "ANGLE")
             ((= key 62) "COLOR NUMBER <RO>")
             ((= key 66) "VERTICES FOLLOW <RO>")
             ((and (= key 70)
                   (= e_type "3DFACE")) (3dface_handler key ent))
             ((= key 71) "MIRROR DIRECTION")
             ((and (>= key 70) (<= key 78)) "INTEGER VALUE")
             ((or (= key 210)
                  (= key 220)
                  (= key 230)) "EXTRUSION DIRECTION COORDINATES")
             ((= key 999) "COMMENTS")
             (T "UNCLASSIFIED VALUE")))

(princ "\rLoading- please wait.. \\")

(defun format-input (key / val label)
       (if (null key) nil
           (progn (setq val (cdr (assoc key entity)))
                  (graphscr)
                  (cond ((= (type val) 'STR)
                         (setq label (strcat (descriptor key etyp) ": "))
                         (princ (strcat "\nCurrent " label))
                         (princ val)
                         (getstring T (strcat "\nNew " label)))
                        ((= (type val) 'REAL)
                         (cond ((and (>= key 40)
                                     (<= key 48)
                                (or (= etyp "CIRCLE")
                                    (= etyp "ARC")))
                                (setvar "coords" 2)
                                (princ "\nCurrent angle: ")
                                (princ val)
                                (getdist (cdr (assoc 10 entity)) "\nNew radius: "))
                               ((and (>= key 50) (<= key 58))
                                (setvar "coords" 2)
                                (princ "\nCurrent angle: ")
                                (princ val)
                                (getangle (cdr (assoc 10 entity)) "\nNew angle: "))
                              (T (setq label (strcat (descriptor key etyp) ": "))
                                 (princ (strcat "\nCurrent " label))
                                 (princ val)
                                 (getreal (strcat "\nNew " label)))))
                         ((= (type val)  'INT)
                          (setq label (strcat (descriptor key etyp) ": "))
                          (princ (strcat "\nCurrent " label))
                          (princ val)
                          (getint (strcat "\nNew " label)))
                         ((= (type val) 'LIST)
                          (setvar "coords" 2)
                          (princ "\nCurrent point value: ")
                          (princ val)
                          (getpoint val "\nNew point: "))))))

(princ "\rLoading- please wait.. \|")

(defun C:CHG (/ entity counter ctr num tag new)
       (if (setq ename (entsel))
           (progn (setq ent (entget (car ename))
                        entity (aux_remove (assoc 0 ent) ent)
                        etyp (cdr (assoc 0 ent))
                        header (strcat etyp " PROPERTY TABLE")
                        num_props (length entity)
                        counter 0
                        ctr 0)
                  (textscr)
                  (repeat 5 (terpri))
                  (repeat (- 38 (/ (strlen header) 2)) (princ "\260"))
                  (princ (strcat " " header " "))
                  (repeat (- 38 (/ (strlen header) 2)) (princ "\260"))
                  (repeat (fix (/ (- 24 num_props) 2.0)) (terpri))
                  (mapcar '(lambda (e)
                                   (setq counter (1+ counter))
                                   (princ (strcat (if (< counter 10)
                                                      (strcat " " (itoa counter))
                                                      (itoa counter))
                                                  "]  "
                                                  (strcat (descriptor (car e) etyp) ": ")))
                                   (princ (cdr e))
                                   (princ "\n"))
                          entity)
                  (repeat (fix (/ (- 24 num_props) 2.0)) (terpri))
                  (setq num (getint "Number of property to change: "))
                  (if (and num
                           (> num 0)
                           (<= num num_props))
                      (progn (setq tag (car (nth (1- num) entity))
                                   new (format-input tag)
                                   ent (subst (cons tag new)
                                              (assoc tag entity) ent)
                                   cmd (getvar "cmdecho"))
                             (setvar "cmdecho" 0)
                             (command "undo" "mark")
                             (setvar "cmdecho" cmd)
                             (entmod ent))
                      (princ "\nInvalid number.")))
           (princ "\nNo entity selected."))
       (princ))

(princ "\rLoading- please wait.. \/")

(defun text_handler (key elist)
       (setq bit_code (cdr (assoc key elist)))
       (cond ((= key 40) "TEXT HEIGHT")
             ((= key 41) "RELATIVE X SCALE FACTOR")
             ((= key 50) "ROTATION ANGLE")
             ((= key 51) "OBLIQUING ANGLE")
             ((= key 70)
              (strcat "ATTRIBUTE FLAG "
                      (cond ((= bit_code 1) "<INVISIBLE>")
                            ((= bit_code 2) "<CONSTANT>")
                            ((= bit_code 4) "<VERIFICATION REQD>")
                            ((= bit_code 8) "<PRESET>")
                            (T "<UNKNOWN BIT CODE>"))))
             ((= key 71)
              (strcat "TEXT GENERATION FLAG "
                      (cond ((= bit_code 0) "")
                            ((= bit_code 2) "<BACKWARDS>")
                            ((= bit_code 4) "<UPSIDE DOWN>")
                            (T "<UNKNOWN BIT CODE>"))))
             ((= key 72)
              (strcat "TEXT JUSTIFICATION FLAG "
                      (cond ((= bit_code 0) "<LEFT JUSTIFIED>")
                            ((= bit_code 1) "<CENTERED ALONG BASELINE>")
                            ((= bit_code 2) "<RIGHT JUSTIFIED>")
                            ((= bit_code 3) "<ALIGNED BETWEEN TWO POINTS>")
                            ((= bit_code 4) "<MIDDLE CENTERED>")
                            ((= bit_code 5) "<FIT BETWEEN TWO POINTS>")
                            (T "<UNKNOWN CODE>"))))
            (T "UNKNOWN TEXT FLAG")))

(princ "\rLoading- please wait.. \-")

(defun pline_handler (key elist)
       (setq bit_code (cdr (assoc key elist)))
       (cond ((= key 40) "STARTING WIDTH")
             ((= key 41) "ENDING WIDTH")
             ((= key 66) "VERTICES FOLLOW FLAG")
             ((= key 70)
              (strcat "POLYLINE FLAG "
                      (cond ((= bit_code 1)  "<CLOSED>")
                            ((= bit_code 2)  "<CURVE-FIT VERTICES ADDED>")
                            ((= bit_code 4)  "<SPLINE-FIT VERTICES ADDED>")
                            ((= bit_code 8)  "<3D POLYLINE>")
                            ((= bit_code 16) "<3D MESH>")
                            ((= bit_code 32) "<3D MESH CLOSED IN N DIRECTION>")
                            (T "<UNKNOWN BIT CODE>"))))
             ((or (= key 71)
                  (= key 72)) (strcat "POLYGON MESH "
                                      (if (= key 71) "M" "N")
                                     " COUNT"))
             ((or (= key 73)
                  (= key 74)) (strcat "POLYGON MESH "
                                      (if (= key 73) "M" "N")
                                      " DENSITY"))
             ((= key 75)
              (strcat "SMOOTH SURFACE TYPE "
                      (cond ((= bit_code 0)  "<NO SMOOTH SURFACE FITTED>")
                            ((= bit_code 5)  "<QUADRATIC B-SPLINE>")
                            ((= bit_code 6)  "<CUBIC B-SPLINE>")
                            ((= bit_code 8)  "<BEZIER SURFACE>")
                            (T "<UNKNOWN BIT CODE>"))))
             (T "UNKNOWN POLYLINE FLAG")))

(princ "\rLoading- please wait.. \\")

(defun 3dface_handler (key elist)
       (setq bit_code (cdr (assoc key elist)))
       (cond ((= key 70)
              (strcat "INVISIBLE EDGE FLAG "
                      (cond ((= bit_code 0)  "<NO")
                            ((= bit_code 1)  "<1ST")
                            ((= bit_code 2)  "<2ND")
                            ((= bit_code 4)  "<3RD")
                            ((= bit_code 8)  "<4TH")
                            (T "UNIDENTIFIED"))
                      " EDGE INVISIBLE>"))))

(princ "\rLoading- please wait.. \|")

(defun aux_remove (atm lst)
       (cond ((null lst) nil)
             ((null (member atm lst)) lst)
             ((equal atm (car lst)) (cdr lst))
             (t (append (reverse (cdr (member atm (reverse lst))))
                        (cdr (member atm lst))))))

(princ "\rFunction C:CHG loaded. Type CHG to start.")
(princ)