;; Program to show list of all xrefs in drawing;
;; uncheck box to unload, check box to reload.
;; extra toggles included for reloading all, unloading all, toggling on/off state.

;; Program by Matt Sibum, Apr 2014.
;; Credit to Afralisp (www.afralisp.net) for some of the coding.

(defun C:xxx (/ xdefault lenlist theList xname count xent xd fname fn l dcl_id xn relist togoff togsw toggle tv togs activedocument thtoglocks yesxref ablock)

(setvar "cmdecho" 0)

(setq xdefault nil)

(getxref)

(setq lenlist (length theList))

; ERROR CHECK IF NO XREFS FOUND
(if (= 0 lenlist)
(alert "\nNo Xrefs Loaded in Drawing...\nProgram Closing...")
(progn
(setq count 0)

(repeat lenlist
(setq xname (nth count theList))
(setq xent (tblsearch "block" xname))
(if
(and
(=(logand(cdr(assoc 70 xent))32)32)
(=(logand(cdr(assoc 70 xent))4)4)
); END AND
(setq xd "1")
(setq xd "0")
); END IF
(setq xdefault (cons xd xdefault))
(setq count (1+ count))
); END REPEAT

(setq xdefault (reverse xdefault))

(vl-load-com)

;;;;;;; create_dialog ;;;;;;;;;

(setq fname (vl-filename-mktemp "dcl.dcl"))

(setq fn (open fname "w"))

(write-line "
temp : dialog {
label = \"Xref List\";
: row {
: boxed_column {
" fn)

(setq count 0)

(repeat lenlist

(write-line ": toggle {" fn)
(setq l (strcat "\"" "tog" (itoa count) "\"" ";"))
(write-line (strcat "key = " l) fn)
(setq l (nth count theList))
(write-line (strcat "label = " "\"" l "\"" "; } ") fn)

(setq count (1+ count))

); END REPEAT

(write-line "
: spacer {} }
: column {
: spacer {}
: button {key = \"togall\" ; label = \"All\" ;}
: button {key = \"tognone\" ; label = \"None\" ;}
: button {key = \"toginv\" ; label = \"Toggle\" ;}
: button {key = \"togdef\" ; label = \"Current\" ; value = 1 ;}
: spacer {}
}
}
: row {
: button {
label = \"OK\" ;
key = \"accept\" ;
is_default = true;

}
: button {
label = \"Cancel\" ;
key = \"cancel\" ;
is_cancel = true;
}
}
: text {label = \"Program Created by Matt Sibum, 2014\"; alignment = left; }
}
" fn)

(close fn)

;;;;;;; end_create_dialog ;;;;;;;;;

(setq dcl_id (load_dialog fname))
(if
(not (new_dialog "temp" dcl_id))
(exit)
); END IF

(swdef)

(action_tile "togall" "(swall)")
(action_tile "tognone" "(swnone)")
(action_tile "toginv" "(swinv)")
(action_tile "togdef" "(swdef)")
(action_tile "accept" "(retxr)(done_dialog)(setq userclick T)")
(action_tile "cancel" "(done_dialog)(setq userclick nil)")

(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete fname)

(if
(= userclick T)
(progn
(setq count 0)
(repeat lenlist
(setq xn (nth count theList))
(if
(= "1" (nth count relist))
(command "-xref" "r" xn)
(command "-xref" "u" xn)
); END IF
(setq count (1+ count))
); END REPEAT
);END PROGN
(princ)
);END IF

); END PROGN

); END IF

); END DEFUN

(princ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun retxr ()

(setq count 0)
(setq relist nil)

(repeat lenlist
(setq l (get_tile (strcat "tog" (itoa count))))
(setq relist (cons l relist))
(setq count (1+ count))
)

(setq relist (reverse relist))
(mode_tile "accept" 2)
); END DEFUN

(princ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun swall ()

(setq count 0)

(repeat lenlist
(setq togon (strcat "tog" (itoa count)))
(set_tile togon "1")
(setq count (1+ count))
); END REPEAT

(mode_tile "accept" 2)

); END DEFUN

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun swnone ()

(setq count 0)

(repeat lenlist
(setq togoff (strcat "tog" (itoa count)))
(set_tile togoff "0")
(setq count (1+ count))
); END REPEAT

(mode_tile "accept" 2)

); END DEFUN

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun swinv ()

(retxr)

(setq count 0)

(repeat lenlist
(setq togsw (nth count relist))
(if
(= "1" togsw)
(setq togsw "0")
(setq togsw "1")
)
(setq toggle (strcat "tog" (itoa count)))
(set_tile toggle togsw)
(setq count (1+ count))
); END REPEAT

(mode_tile "accept" 2)

); END DEFUN

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun swdef ()

(setq count 0)

(repeat lenlist
(setq tv (nth count xdefault))
(setq togs (strcat "tog" (itoa count)))
(set_tile togs tv)
(setq count (1+ count))
); END REPEAT

(mode_tile "accept" 2)

); END DEFUN

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This lisp (getxref) from Afralisp wtogsite (www.afralisp.net)
;; http://www.afralisp.net/archive/Tips/code66.htm

(defun getxref ()
(vl-load-com)

; RETRIEVE A REFERENCE TO THE ACTIVE DOCUMENT
(setq activedocument (vla-get-activedocument (vlax-get-Acad-Object)))

; RETRIEVE A REFERENCE TO THE BLOCKS
(setq thtoglocks (vla-get-blocks activedocument))

; CREATE AN EMPTY LIST FOR XREF NAMES
(setq theList '())

; PROCESS EACH BLOCK
(vlax-for item thtoglocks

; CHECK IF IT'S AN XREF
(setq yesxref (vlax-get-property item 'isXref))

; IF IT IS
(if (= yesxref :vlax-true)

; DO THE FOLLOWING
(progn

; GET THE XREF NAME
(setq ablock (vlax-get-property item 'Name))

; STORE IT IN THE LIST
(setq theList (append (list ablock) theList))

); PROGN

); IF

); VLAX-FOR

(princ)

); END DEFUN

(princ)

(c:xxx)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Advertisements