Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;;; -*- 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)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement