(prompt "\n(c)Kramer Consulting, Inc. Utility Set *FREEWARE*") ;;--------------------------------------------------------------------- ;; CHANGES.LSP ;; ;; FREEWARE Program - you are free to make copies of this and supply it ;; to others as is. Author and company make no ;; warrenty on the fitness of this program for anything ;; other than using as an example when learning ;; AutoLISP. ;; ;; Adapted from the CADENCE November 1996 article by Bill Kramer ;; ;; (LAYER_UPDATE) function to change a set of entity objects layer ;; layer assignments. ;; (Z_UPDATE) function changes Z settings for entities. ;; ;;----------------------------------------------- ;; Layer Update Utility ;;----------------------------------------------- (defun Layer_Update ( SS1 ;;selection set of entities LayerList ;;layer association list / EL ;;entity list CNT ;;counter LYR ;;layer name New ;;New layer name ) ;;set counter for number of items in ;;the selection set SS1, make sure it is ;;a valid selection set first. (if (and SS1 (= (type SS1) 'PICKSET)) (setq CNT (sslength SS1)) (setq CNT 0) ) ;;Repeat loop for each entity in the set (repeat CNT ;;get the entity list from the names ;;in the selection set (setq EL (entget (ssname SS1 (setq CNT ;;counter update (1- CNT)))) ;;get layer name from entity list LYR (cdr (assoc 8 EL)) ) ;;Is the layer name in the association ;;list passed as a parameter? (if (setq New (assoc LYR LayerList)) (progn ;;Yes, layer name in list, ;;update the entity list contents ;;using the substitute function. (setq EL (subst (cons 8 (cadr New)) (assoc 8 EL) EL)) ;;Send modified entity back to ;;drawing database. (entmod EL) ;;If the object is a complex one, ;;then we must issue a REGEN for ;;it as well. This will udpate ;;all of the sub-entities associated ;;with the primary object. (if (member (cdr (assoc 0 EL)) '("INSERT" "POLYLINE" )) (entupd ;;Get the entity name (cdr (assoc -1 EL))) ) ;;end IF MEMBER )) ;;end IF PROGN ) ;;end REPEAT ) ;;end DEFUN ;;----------------------------------------------- ;; Z update utility ;;----------------------------------------------- (defun Z_Update ( SS1 ;;pick set of entities Zval ;;Z setting Zflag ;;nil for abs, 'T for relative / EL ;;entity list EN ;;entity name CNT ;;counter ) ;;Set counter to number of entities in ;;selection set SS1 after checking if ;;a valid argument was provided. (if (and SS1 (= (type SS1) 'PICKSET)) (setq CNT (sslength SS1)) (setq CNT 0) ) ;;Repeat Loop for each entity in the ;;selection set. (repeat CNT (setq CNT (1- CNT) ;;update counter ;;Get the selection set. EL (entget (ssname SS1 CNT)) ) ;;Modify entity list in database ;;with value returned from function ;;(Ent_Z_Update) which is defined ;;in Listing 4. (entmod (Ent_Z_Update EL Zval ZFlag)) ;; ;;Check to see if entity is a block ;;insertion with attributes or a ;;polyline. If so, it has sub entities ;;that need to be changed as well. (if (or (and (= (cdr (assoc 0 EL)) "INSERT") (= (cdr (assoc 67 EL)) 1)) (= (cdr (assoc 0 EL)) "POLYLINE") ) (progn ;;Has sub-entities, ;;Get the entity name and save it ;;for a later regen after all changes ;;have been made. (setq EN (cdr (assoc -1 EL))) ;; ;;While we do not encounter the ;;end of the complex entity definition, (while (/= (cdr (assoc 0 EL)) "SEQEND") ;;modify the entity Z values. (entmod (Ent_Z_Update (setq EL ;;New EL (entget ;;from next entity (entnext ;;given current (cdr ;;EL value. (assoc -1 EL))))) Zval ZFlag) ) ) ;;end WHILE ;;Update / Regen the complex entity. (entupd EN) )) ;;end IF PROGN ) ;;end REPEAT loop ) ;;end DEFUN ;;------------------------------------------------ ;; Z Update for an entity list ;;----------------------------------------------- (defun Ent_Z_Update ( EL ;;entity list Zval ;;z value Zflag ;;nil for abs, 't for rel / P ;;point list group Pz ;;Z value from P Z ;;Z value from elevation Grp ;;point group code ) ;;First we will check the elevation ;;setting and see if there is anything ;;to change there. Elevation is stored ;;in group code 38 in an entity list. (setq Z (cdr (assoc 38 EL)) Z (if Z ;;got a value? (if ZFlag ;;flag check (+ Z Zval) ;;relative Zval ;;absolute ) ) ) (if Z ;;got a value? (setq EL ;;update entity list for (subst ;;group code 38. (cons 38 Z) (assoc 38 Z) EL))) ;; ;;Now check the group codes 10 and ;;greater for point lists containing ;;Z settings. (setq Grp 10) ;; ;;Does object have a group code 10 ;;or greater in it's entity list? ;;and does this point have a Z value? (while (and (setq P (assoc Grp EL)) (setq Pz (cadddr P))) ;;Yes it does, Get it and ;;update the value. (setq Pz (if ZFlag (+ Pz Zval) Zval) ;;Rebuild the point list P (list (car P) ;;group code (cadr P) ;;X value (caddr P) ;;Y value Pz) ;;New Z value ;;Update the entity list EL (subst P (assoc Grp EL) EL) ;;Incremnt the group code Grp (1+ Grp) ) ) ;;end WHILE loop EL ;;return the entity list for use in ;;calling function. ) ;;----------------------------------------------- ;; Test function for layer conversion. ;;----------------------------------------------- (defun C:TEST1 ( / LL ;;association layer list T1 ;;existing object layer T2 ;;new layer name SS1 ;;selection set to change ) (prompt "\nLayer Conversion Test.") ;; ;;Build the association layer list first. It ;;contains the layer names you want to change ;;in the drawing with the new layer names in a ;;sub-list. The association layer list has a ;;format of (("old_layer" "new_layer")...) and ;;is NOT a dotted pair for expansion reasons. (while (/= "" ;;Check for empty entry. (setq T1 (getstring "\nLayer to change: "))) (setq T2 (getstring " change to: ")) (if (/= T2 "") ;;Check for empty entry. ;;Build up the association layer list, (setq LL (cons ;;by adding new info to front. (list T1 T2) LL))) ) ;; (prompt "\nSelect the objects to change: ") (setq SS1 (ssget)) ;; ;;Call the function in Listing 1. (Layer_Update SS1 LL) ;; (princ) ) ;;----------------------------------------------- ;; Test function for Z Update ;;----------------------------------------------- (defun C:TEST2 ( / SS1 ;;selection set NewZ ;;real number, Z change value ZFlag ;;Z change type ) (prompt "\nZ Change function test.") ;;Operator term options can be included ;;in INITGET to provide subtle language ;;difference options. (initget 0 "Absolute Fix New Relative Incremental Add") (setq ZFlag (getkword "\nType of change /Relative: ")) ;; ;;Set to default if just Enter pushed. (if (null ZFlag) (setq ZFlag "Absolute")) ;; ;;Check options to see which one was selected, ;;ZFlag is set to nil for absolute and True ;;for relative. (setq ZFlag (if (member Zflag '("Absolute" "Fix" "New")) nil 'T)) ;; ;;Z changes by what value? Ask the user for ;;the new setting, but phrase the question ;;based on the previous answer concerning the ;;type of change. (setq NewZ (getreal (if ZFlag "\nAdd how much to each Z value: " "\nNew Z value to place in entities: "))) ;; ;;If the operator supplied a Z value to the ;;previous question, then ask what they ;;want to change and run the Z_Update ;;function defined in Listing 3. (if NewZ (progn (prompt "\nSelect the objects to change: ") (setq SS1 (ssget)) (Z_Update SS1 NewZ ZFlag) )) (princ) ) ;;end DEFUN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END OF FILE (princ)