;main routine
(defun C:tg2 (/ dcl_id action selection
startingnumber prefix starttaginfo
TAGLENGTH lasttime p1
blockscale NEW_ATTOBJ COUNTERNUMBERSTRING
EXISTING_ATTOBJ ORIGINAL_LAYER info
tagged_items CURRENT_ENT TAGGED_LIST
e1 e2 temp
DIALOGSTATUS prefix taginfo
taglength startingnumber tag_selection
password_value smart_tags counter
TEMP
)
(defun *error* (msg)
(if (AND (/= msg "quit / exit abort")(/= msg "Function cancelled"))
(princ (strcat "error: " msg))
(princ))
(princ)
)
;LOADS APPLICATION FOR USE WITH EXTENDED DATA
(IF (NOT (tblsearch "appid" "TAGCOUNTER"))(regapp "TAGCOUNTER"))
;for beggining, TURNS OFF ATTRIBUTE PROMPTING AFTER INSERTION
(if (= (getvar "ATTREQ") 1 )(setvar "ATTREQ" 0))
;initializes dialog box
(setq dcl_id (load_dialog "TAGGER"))
;initializes tagger to be the 1st dialog box called
(if (not (new_dialog "TAGGER_box" dcl_id)) (exit))
;defines subroutine for action to take when buttons are pressed
(defun action ()
(setq selection $key)
(done_dialog))
;ROUTINE FOR EXISTING TAGS MODIFIED
(DEFUN MODIFY_EXISTING ()
(setq dcl_id (load_dialog "TAGGER"))
(if (not (new_dialog "EXISTING_BOX" dcl_id)) (exit))
(action_tile "renumber" "(action)")
(action_tile "insert" "(action)")
(action_tile "remove" "(action)")
(action_tile "no_smart" "(action)")
(action_tile "tag_list" "(action)")
(if (not (ssget "X" '((-3("TAGCOUNTER")))))(mode_tile "insert" 1));disables button of can't use
(if (not (ssget "X" '((-3("TAGCOUNTER")))))(mode_tile "remove" 1));disables button of can't use
(if (not (ssget "X" '((-3("TAGCOUNTER")))))(mode_tile "no_smart" 1));disables button of can't use
(if (not (ssget "X" '((-3("TAGCOUNTER")))))(mode_tile "tag_list" 1));disables button of can't use
(start_dialog)
(unload_dialog dcl_id)
(if (= selection "renumber")(update))
(if (= selection "insert")(add_tag))
(if (= selection "remove")(remove_tag))
(if (= selection "no_smart")(remove_smart))
(if (= selection "tag_list")(list_tags))
)
;DEFINES ACTIONS TO TAKE WHEN BUTTONS ARE PRESSED
(action_tile "new" "(action)")
(action_tile "existing" "(action)")
(if (not (OR (ssget "X" '((-3("TAGCOUNTER"))))(ssget "X" '((0 . "INSERT")(2 . "DATA-TAG")))))(mode_tile "existing" 1))
;disables button of none are in dwg
(start_dialog)
; runs the routine for new tags to be added
(if (= selection "new")(new_tag_series))
(if (= selection "existing")(MODIFY_EXISTING))
;unloads the dialog
(unload_dialog dcl_id)
; exits quietly
(princ)
)
;end of main routine
;gets values with a dialog box
(DEFUN GETVALUES (/ starttaginfo dcl_id)
;initializes dialog box
(SETQ startingnumber NIL)
(SETQ prefix NIL)
(defun starttaginfo ()
(setq dcl_id (load_dialog "TAGGER"))
(if (not (new_dialog "INPUT_box" dcl_id)) (exit))
(setq startingnumber "a")
(action_tile "prefix" "(setq prefix $value)")
(action_tile "number" "(setq startingnumber $value)")
(action_tile "cancel" "(exit)")
(action_tile "values" "(done_dialog 3))")
(if (not (ssget "X" '((-3("TAGCOUNTER")))))(mode_tile "values" 1));disables button of none are in dwg
(SETQ DIALOGSTATUS (start_dialog))
(while (= DIALOGSTATUS 3)
(setq tag_selection nil)
(setq prefix nil)
(setq taginfo nil)
(setq taglength nil)
(setq startingnumber nil)
(while (not tag_selection)
(if (setq tag_selection (entsel "\nSelect The Tag To Start With:"))
(if (assoc -3 (setq taginfo (ENTGET (car tag_selection) '("TAGCOUNTER"))));if something is selected with extended data
(if (= (cdr (assoc 2 (ENTGET (car tag_selection))))"DATA-TAG")(progn ;if object is named data tag
(setq prefix (cdr (assoc 1000 (vl-remove "TAGCOUNTER" (cadr (ASSOC -3 taginfo))))))
(setq taglength (strlen (vl-string-left-trim prefix (cdr (assoc 1 (entget (entnext (cdr (assoc -1 taginfo)))))))))
(SETQ startingnumber (ITOA (CDR (ASSOC 1070 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 taginfo)))))))
(WHILE (< (STRLEN
startingnumber) TAGLENGTH)
(SETQ startingnumber (STRCAT "0" startingnumber)))
(new_dialog "INPUT_box" dcl_id)
(set_tile "prefix" prefix)
(action_tile "prefix" "(setq prefix $value)")
(set_tile "number" startingnumber)
(action_tile "number" "(setq startingnumber $value)")
(action_tile "values" "(done_dialog 3))")
(action_tile "cancel" "(exit)")
(SETQ DIALOGSTATUS (start_dialog))
))
(progn
(setq tag_selection nil)
(princ "\nInvalid Selection."))
)
(princ "\nNothing Selected.")
)
))
(done_dialog)
(unload_dialog dcl_id)
(SETQ TAGLENGTH (STRLEN startingnumber))
(if (and (/= startingnumber "0")(= (atoi startingnumber) 0))(setq startingnumber nil)(setq startingnumber (ABS (atoi startingnumber)))))
;FORCES A NUMBER AS INPUT
(while (not startingnumber)
(starttaginfo)
(if (not startingnumber)(alert "Invalid Starting Number"))
)
;EXTENDED DATA WILL NOT ACCEPT NIL AS INPUT
(if (not prefix)(setq prefix ""))
);end of get values
;places new numerical tags in the drawing
(DEFUN new_tag_series (/ lasttime startingnumber prefix)
(GETVALUES)
(SETQ ORIGINAL_LAYER (GETVAR "CLAYER"))
;LOADS & MODIFIES LAYER IF NEEDED
(if (NOT (TBLSEARCH "LTYPE" "CONTINUOUS"))(COMMAND "LINETYPE" "L" "CONTINUOUS" "" ""))
(if (TBLSEARCH "LAYER" "DATA-LABEL-TAG")(progn
(setq info (entget (tblobjname "LAYER" "DATA-LABEL-TAG")))
(if (or (/= (assoc 62 info)(cons 62 1))(/= (assoc 6 info)(cons 6 "CONTINUOUS")))(progn
(if (/= (assoc 62 info)(cons 62 1))(setq info (subst (cons 62 1)(assoc 62 info) info)))
(if (/= (assoc 6 info)(cons 6 "CONTINUOUS"))(setq info (subst (cons 6 "CONTINUOUS")(assoc 6 info) info)))
(entmod info))))
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(2 . "DATA-LABEL-TAG")
'(70 . 0)
'(62 . 1)
'(6 . "CONTINUOUS")
'(290 . 1)
'(370 . -3))))
;SETS CURRENT LAYER
(SETVAR "CLAYER" "DATA-LABEL-TAG")
(WHILE (not lasttime)
(initget "Done")
(setq p1 (getpoint "\nSpecify center point for datatag [Done tagging]:"))
(if (or (not p1)(= p1 "Done"))(progn
(setq lasttime T)
))
;bypasses last time
(if (not lasttime)(progn
;if sty has been set, that value is used for blockscale, if not 1 is used
(if (dictsearch (namedobjdict) "XRECLIST")
(setq blockscale (cdr (assoc 40 (dictsearch (namedobjdict) "XRECLIST"))))
(setq blockscale 1))
;inserts object into drawing
(command "._INSERT" "EP_Block=blocks.dwg" "0,0,0" "1" "1" "0" "._erase" (entlast) "" "._purge" "B" "EP_Block" "N")
(setq NEW_ATTOBJ (ssget "X" '((0 . "INSERT") (2 . "DATA-TAG"))))
;xdata attached to object
(if (not (ASSOC -3 (ENTGET NEW_ATTOBJ '("TAGCOUNTER"))))(progn
(SETQ NEW_ATTOBJ
(append (entget NEW_ATTOBJ)
(list (cons -3 (list (list '"TAGCOUNTER" '(1002 . "{")(cons 1070 startingnumber)(cons 1000 prefix)'(1002 . "}")))))))
(entmod NEW_ATTOBJ)
(SETQ COUNTERNUMBERSTRING (ITOA (CDR (ASSOC 1070 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 NEW_ATTOBJ)))))))
(WHILE (< (STRLEN
COUNTERNUMBERSTRING) TAGLENGTH)
(SETQ COUNTERNUMBERSTRING (STRCAT "0" COUNTERNUMBERSTRING)))
;UPDATES ATTRIBUTE TO EXTENDED DATA VALUE
(SETQ NEW_ATTOBJ (SUBST
(CONS 1 (STRCAT
(CDR (ASSOC 1000 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 NEW_ATTOBJ)))));RETURNS STRING
COUNTERNUMBERSTRING
));RETURNS INTEGER AS A STRING
(ASSOC 1 (ENTGET (ENTNEXT (CDR (ASSOC -1 NEW_ATTOBJ)))))
(ENTGET (ENTNEXT (CDR (ASSOC -1 NEW_ATTOBJ))))))
(ENTMOD NEW_ATTOBJ)
(ENTUPD (ENTNEXT (CDR (ASSOC -1 NEW_ATTOBJ))))
;adds a lock to the attribute so it cant be changed
(SETQ NEW_ATTOBJ (SUBST
(cons 70 2)
(ASSOC 70 NEW_ATTOBJ)
NEW_ATTOBJ))
(ENTMOD NEW_ATTOBJ)
))
(SETQ startingnumber (1+ startingnumber))
)
))
;RESTORES ORIGINAL LAYER
(SETVAR "CLAYER" ORIGINAL_LAYER)
);end of placing new numerical tags in the drawing
;update routines
(defun update ()
(ALERT "In the next box, enter the first value of the new numbering scheme.
The new tag numbers will be based off of these values.
You will be prompted to select the tag objects to renumber individually.")
(GETVALUES)
(WHILE (not lasttime)
(WHILE (NOT EXISTING_ATTOBJ)
(initget "Done")
(SETQ EXISTING_ATTOBJ (entsel "\nSelect a Data Tag to Update [Done updating]:"))
(if (/= EXISTING_ATTOBJ "Done")(progn
(IF (NOT EXISTING_ATTOBJ)(PRINC "\nNothing Selected. >> ")
(IF (or (/= (cdr (assoc 0 (entget (car EXISTING_ATTOBJ)))) "INSERT")
(/= (cdr (assoc 2 (entget (car EXISTING_ATTOBJ)))) "DATA-TAG"))
(progn
(PRINC "\nInvalid Object Selected. >> ")
(SETQ EXISTING_ATTOBJ nil))
)))
(setq lasttime T)
)
);end of while
;bypasses last time
(if (not lasttime)(progn
(SETQ EXISTING_ATTOBJ (car EXISTING_ATTOBJ))
(if (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER")));removes extended data
(entmod (append (entget EXISTING_ATTOBJ) (list (list -3 (list "TAGCOUNTER")))))
)
;xdata attached to object
(SETQ EXISTING_ATTOBJ
(append (entget EXISTING_ATTOBJ)
(list (cons -3 (list (list '"TAGCOUNTER" '(1002 . "{")(cons 1070 startingnumber)(cons 1000 prefix)'(1002 . "}")))))))
(entmod EXISTING_ATTOBJ)
(SETQ COUNTERNUMBERSTRING (ITOA (CDR (ASSOC 1070 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 EXISTING_ATTOBJ)))))))
(WHILE (< (STRLEN
COUNTERNUMBERSTRING) TAGLENGTH)
(SETQ COUNTERNUMBERSTRING (STRCAT "0" COUNTERNUMBERSTRING)))
;UPDATES ATTRIBUTE TO EXTENDED DATA VALUE
(SETQ EXISTING_ATTOBJ (SUBST
(CONS 1 (STRCAT
(CDR (ASSOC 1000 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 EXISTING_ATTOBJ)))));RETURNS STRING
COUNTERNUMBERSTRING
));RETURNS INTEGER AS A STRING
(ASSOC 1 (ENTGET (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ)))))
(ENTGET (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ))))))
(ENTMOD EXISTING_ATTOBJ)
(ENTUPD (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ))))
;adds a lock to the attribute so it cant be changed
(SETQ EXISTING_ATTOBJ (SUBST
(cons 70 2)
(ASSOC 70 EXISTING_ATTOBJ)
EXISTING_ATTOBJ))
(ENTMOD EXISTING_ATTOBJ)
(redraw (cdr (assoc 330 EXISTING_ATTOBJ)) 3)
(SETQ startingnumber (1+ startingnumber))
(setq EXISTING_ATTOBJ nil)
))
)
);end of update
(defun remove_tag (/ TAGGED_LIST EXISTING_ATTOBJ)
(SETQ EXISTING_ATTOBJ NIL)
(ALERT "Select the tag that you would like to remove.\nIt will be deleted, and all of the tags in the\nsame prefix series will be renumbered if applicable.")
(WHILE (NOT EXISTING_ATTOBJ)
(SETQ EXISTING_ATTOBJ (entsel "\nSelect a Data Tag to Remove:"))
(IF (NOT EXISTING_ATTOBJ)(PRINC "\nNothing Selected. >> ")
(IF (or (/= (cdr (assoc 0 (entget (car EXISTING_ATTOBJ)))) "INSERT")
(/= (cdr (assoc 2 (entget (car EXISTING_ATTOBJ)))) "DATA-TAG"))
(progn
(PRINC "\nInvalid Object Selected. >> ")
(SETQ EXISTING_ATTOBJ nil))
))
)
(SETQ EXISTING_ATTOBJ (car EXISTING_ATTOBJ))
(if (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER")))(progn;if there is extended data -
(setq prefix (cdr (assoc 1000 (vl-remove "TAGCOUNTER" (cadr (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER"))))))))
(setq startingnumber (cdr (assoc 1070 (vl-remove "TAGCOUNTER" (cadr (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER"))))))))
(entdel EXISTING_ATTOBJ)
;COMPOSES A LIST OF ALL TAGGED OBJECTS with the same prefix
(SETQ tagged_items (ssget "X" '((-3("TAGCOUNTER")))))
(SETQ COUNTER 0)
(WHILE (> (SSLENGTH tagged_items) COUNTER)
(SETQ CURRENT_ENT (ssname tagged_items COUNTER))
(if (= (cdr (assoc 1000 (vl-remove "TAGCOUNTER" (cadr (ASSOC -3 (ENTGET CURRENT_ENT '("TAGCOUNTER"))))))) prefix)
(setq TAGGED_LIST
(APPEND (LIST (LIST (cdr (assoc 1070 (CdAdR (ASSOC -3 (entget CURRENT_ENT '("TAGCOUNTER")))))) CURRENT_ENT))
TAGGED_LIST)))
(SETQ COUNTER (1+ COUNTER)))
;arranges tagged list in numerical order
(setq TAGGED_LIST (vl-sort TAGGED_LIST (function (lambda (e1 e2)(< (car e1) (car e2))))))
(setq counter startingnumber)
(foreach temp TAGGED_LIST
(if (= (car temp) (1+ counter))(progn
(SETQ EXISTING_ATTOBJ (cadr temp))
(if (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER")));removes extended data
(entmod (append (entget EXISTING_ATTOBJ) (list (list -3 (list "TAGCOUNTER")))))
)
;xdata attached to object
(SETQ EXISTING_ATTOBJ
(append (entget EXISTING_ATTOBJ)
(list (cons -3 (list (list '"TAGCOUNTER" '(1002 . "{")(cons 1070 counter)(cons 1000 prefix)'(1002 . "}")))))))
(entmod EXISTING_ATTOBJ)
(SETQ COUNTERNUMBERSTRING (ITOA (CDR (ASSOC 1070 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 EXISTING_ATTOBJ)))))))
(setq taglength (strlen (vl-string-left-trim prefix (cdr (assoc 1 (entget (entnext (cdr (assoc -1 EXISTING_ATTOBJ)))))))))
(WHILE (< (STRLEN
COUNTERNUMBERSTRING) TAGLENGTH)
(SETQ COUNTERNUMBERSTRING (STRCAT "0" COUNTERNUMBERSTRING)))
;UPDATES ATTRIBUTE TO EXTENDED DATA VALUE
(SETQ EXISTING_ATTOBJ (SUBST
(CONS 1 (STRCAT
(CDR (ASSOC 1000 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 EXISTING_ATTOBJ)))));RETURNS STRING
COUNTERNUMBERSTRING
));RETURNS INTEGER AS A STRING
(ASSOC 1 (ENTGET (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ)))))
(ENTGET (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ))))))
(ENTMOD EXISTING_ATTOBJ)
(ENTUPD (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ))))
;adds a lock to the attribute so it cant be changed
(SETQ EXISTING_ATTOBJ (SUBST
(cons 70 2)
(ASSOC 70 EXISTING_ATTOBJ)
EXISTING_ATTOBJ))
(ENTMOD EXISTING_ATTOBJ)
(redraw (cdr (assoc 330 EXISTING_ATTOBJ)) 3)
(setq counter (1+ counter)))
)
);end of foreach
)
(alert "This Data Tag does not contain imbedded tag number information.
It can not be automatically removed from the series.")
);end of if
);end of defun
(defun add_tag (/ TAGGED_LIST EXISTING_ATTOBJ XSCALE YSCALE TAGGED_LIST taglength_ORIGINAL)
(SETQ EXISTING_ATTOBJ NIL)
(ALERT "Select the tag that you would like to add an additional one behind.\nAll of the tags in the same prefix series will be renumbered if applicable.")
(WHILE (NOT EXISTING_ATTOBJ)
(SETQ EXISTING_ATTOBJ (entsel "\nSelect a Data Tag to Add After:"))
(IF (NOT EXISTING_ATTOBJ)(PRINC "\nNothing Selected. >> ")
(IF (or (/= (cdr (assoc 0 (entget (car EXISTING_ATTOBJ)))) "INSERT")
(/= (cdr (assoc 2 (entget (car EXISTING_ATTOBJ)))) "DATA-TAG"))
(progn
(PRINC "\nInvalid Object Selected. >> ")
(SETQ EXISTING_ATTOBJ nil))
))
)
(SETQ EXISTING_ATTOBJ (car EXISTING_ATTOBJ))
(if (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER")))(progn;if there is extended data -
(setq prefix (cdr (assoc 1000 (vl-remove "TAGCOUNTER" (cadr (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER"))))))))
(setq startingnumber (cdr (assoc 1070 (vl-remove "TAGCOUNTER" (cadr (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER"))))))))
;SETS SCALE FACTOR OF ORIGINAL BLOCK SO IT CAN BE MATCHED
(SETQ XSCALE (CDR (ASSOC 41 (ENTGET EXISTING_ATTOBJ)))
YSCALE (CDR (ASSOC 42 (ENTGET EXISTING_ATTOBJ))))
(setq taglength_ORIGINAL (strlen (vl-string-left-trim prefix (cdr (assoc 1 (entget (entnext (cdr (assoc -1 (ENTGET EXISTING_ATTOBJ))))))))))
;COMPOSES A LIST OF ALL TAGGED OBJECTS with the same prefix
(SETQ tagged_items (ssget "X" '((-3("TAGCOUNTER")))))
(SETQ COUNTER 0)
(WHILE (> (SSLENGTH tagged_items) COUNTER)
(SETQ CURRENT_ENT (ssname tagged_items COUNTER))
(if (= (cdr (assoc 1000 (vl-remove "TAGCOUNTER" (cadr (ASSOC -3 (ENTGET CURRENT_ENT '("TAGCOUNTER"))))))) prefix)
(setq TAGGED_LIST
(APPEND (LIST (LIST (cdr (assoc 1070 (CdAdR (ASSOC -3 (entget CURRENT_ENT '("TAGCOUNTER")))))) CURRENT_ENT))
TAGGED_LIST)))
(SETQ COUNTER (1+ COUNTER)))
;arranges tagged list in numerical order
(setq TAGGED_LIST (vl-sort TAGGED_LIST (function (lambda (e1 e2)(< (car e1) (car e2))))))
(setq counter (1+ startingnumber))
(foreach temp TAGGED_LIST
(if (= (car temp) counter)(progn
(SETQ EXISTING_ATTOBJ (cadr temp))
(if (ASSOC -3 (ENTGET EXISTING_ATTOBJ '("TAGCOUNTER")));removes extended data
(entmod (append (entget EXISTING_ATTOBJ) (list (list -3 (list "TAGCOUNTER")))))
)
;xdata attached to object
(SETQ EXISTING_ATTOBJ
(append (entget EXISTING_ATTOBJ)
(list (cons -3 (list (list '"TAGCOUNTER" '(1002 . "{")(cons 1070 (1+ counter))(cons 1000 prefix)'(1002 . "}")))))))
(entmod EXISTING_ATTOBJ)
(SETQ COUNTERNUMBERSTRING (ITOA (CDR (ASSOC 1070 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 EXISTING_ATTOBJ)))))))
(setq taglength (strlen (vl-string-left-trim prefix (cdr (assoc 1 (entget (entnext (cdr (assoc -1 EXISTING_ATTOBJ)))))))))
(WHILE (< (STRLEN
COUNTERNUMBERSTRING) TAGLENGTH)
(SETQ COUNTERNUMBERSTRING (STRCAT "0" COUNTERNUMBERSTRING)))
;UPDATES ATTRIBUTE TO EXTENDED DATA VALUE
(SETQ EXISTING_ATTOBJ (SUBST
(CONS 1 (STRCAT
(CDR (ASSOC 1000 (vl-remove "TAGCOUNTER" (CADR (ASSOC -3 EXISTING_ATTOBJ)))));RETURNS STRING
COUNTERNUMBERSTRING
));RETURNS INTEGER AS A STRING
(ASSOC 1 (ENTGET (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ)))))
(ENTGET (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ))))))
(ENTMOD EXISTING_ATTOBJ)
(ENTUPD (ENTNEXT (CDR (ASSOC -1 EXISTING_ATTOBJ))))
;adds a lock to the attribute so it cant be changed
(SETQ EXISTING_ATTOBJ (SUBST
(cons 70 2)
(ASSOC 70 EXISTING_ATTOBJ)
EXISTING_ATTOBJ))
(ENTMOD EXISTING_ATTOBJ)
(redraw (cdr (assoc 330 EXISTING_ATTOBJ)) 3)
(setq counter (1+ counter)))
)
);end of foreach
