Undo Bound Objects

[docsaintly]

I'm sure many of you are aware that bound objects are like a terrible disease you can't get rid of. I'm wondering if there is a tool in existence that will "unbind" objects, and strip out all the (XREFNAMEHERE$)layername entries in the object's styles, layers, etc. Any responses are appreciated.

[ntswift]

;;;==UNBIND.LSP=====================================================
;;; This program "unbinds" bound xreferences
;;; removing the bound items and recreating the original file
;;;
;;;==================================================================
(prompt "\nUNBIND\nLoading ...")
(defun C:UNBIND (/ BLCK BLK_NAME EXPR WBLOK)
(setq EXPR (getvar "expert"))
(setvar "EXPERT" 4)
(setvar "CMDECHO" 0)
;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
(cond
( (and ai_dcl (listp ai_dcl))) ; it's already loaded.

( (not (findfile "ai_utils.lsp")) ; find it
(ai_abort "SPECIAL"
(strcat "Can't locate file AI_UTILS.LSP."
"\n Check support directory.")))

( (eq "failed" (load "ai_utils" "failed")) ; load it
(ai_abort "SPECIAL" "Can't load file AI_UTILS.LSP"))
)
(command "-layer" "on" "*" "thaw" "*" "unlock" "*" "S" "0" "")

(setq blk_list (ai_table "block" 14)) ; no anonymous, Xrefs or
; Xref dependents.

(setq rep 0)
(repeat (length blk_list)
(setq BLCK_NAME (nth rep blk_list))
(progn
(if (wcmatch BLCK_NAME "*$#$*");bound block

(progn
(setq head (substr BLCK_NAME 1 (str_pos "$" BLCK_NAME))
whead (strcat head "*")
fname (substr head 1 (- (strlen head) 1))
)
(setq flist (list '(-4 . " (cons 8 whead)
(cons 2 whead)
(cons 6 whead)
(cons 7 whead)
(cons 3 whead)
'(-4 . "OR>")
)
)
(setq xsels (ssget "X" flist))
(command "wblock" fname "" "0,0" xsels "")
(command "purge" "a" "" "n")
(command "purge" "a" "" "n")
(command "purge" "a" "" "n")
(command "purge" "a" "" "n")
);end progn
);endif
);end progn
(setq rep (+ 1 rep))
);end repeat

(setvar "EXPERT" EXPR)
(prompt "\n")
(prompt "\nWBlocking complete.")
(princ)
)
(defun STR_POS (schar sstring / )
(setq ptr (strlen sstring)
ctr 0
fnd nil)
(while (and (< ctr ptr)(not fnd))
(setq ctr (+ 1 ctr))
(setq fnd (or fnd (= (substr sstring ctr 1) schar)))
);end while
(setq ctr ctr)
)

[docsaintly]

Thanks for the response, but I can tell from the code that it is missing some referenced .lsp files. Can you provide those as well?

[docsaintly]

Sorry for the double post. But another thing, i'm hoping this tool will do it to objects and not just a block. For instance, a block called XREFNAME$Keynote on the later XREFNAME$Layer with attributes on the style XREFNAME$Style etc. etc.

[stevor]

Here is one, found by google:

;;; (ai_table )
;;;
;;; Returns a list of items in the specified table. The bit values have the
;;; following meaning:
;;; 0 List all items in the specified table.
;;; 1 Do not list Layer 0 and Linetype CONTINUOUS.
;;; 2 Do not list anonymous blocks or anonymous groups.
;;; A check against the 70 flag for the following bit:
;;; 1 anonymous block/group
;;; 4 Do not list externally dependant items.
;;; A check against the 70 flag is made for any of the following
;;; bits, which add up to 48:
;;; 16 externally dependant
;;; 32 resolved external or dependant
;;; 8 Do not list Xrefs.
;;; A check against the 70 flag for the following bit:
;;; 4 external reference
;;; 16 Add BYBLOCK and BYLAYER items to list.
;;;
(defun ai_table (table_name bit / tbldata table_list just_name)
(setq tbldata nil)
(setq table_list '())
(setq table_name (xstrcase table_name))
(while (setq tbldata (tblnext table_name (not tbldata)))
(setq just_name (cdr (assoc 2 tbldata)))
(cond
((= "" just_name)) ; Never return null Shape names.
((and (= 1 (logand bit 1))
(or (and (= table_name "LAYER") (= just_name "0"))
(and (= table_name "LTYPE")
(= just_name "CONTINUOUS")
)
)
))
((and (= 2 (logand bit 2))
(= table_name "BLOCK")
(= 1 (logand 1 (cdr (assoc 70 tbldata))))
))
((and (= 4 (logand bit 4))
;; Check for Xref dependents only.
(zerop (logand 4 (cdr (assoc 70 tbldata))))
(not (zerop (logand 48 (cdr (assoc 70 tbldata)))))

))
((and (= 8 (logand bit 8))
(not (zerop (logand 4 (cdr (assoc 70 tbldata)))))
))
;; Vports tables can have similar names, only display one.
((member just_name table_list)
)
(T (setq table_list (cons just_name table_list)))
)
)
(cond
((and (= 16 (logand bit 16))
(= table_name "LTYPE") ) (setq table_list (cons "BYBLOCK"
(cons "BYLAYER" table_list))) )
(t)
)
(ai_return table_list)
)

[Anonymous]

Are you trying to fix drawings from consultants or something you created?
If you are doing it to yourself, have you considered using xrefinsert rather
than xrefbind?

The name prefixes are not a disease. They are a designed approach to
avoiding name conflicts. Any program to replace bound objects by stripping
the prefixes needs to know how name conflicts need to be resolved.

wrote in message news:6117492@discussion.autodesk.com...
I'm sure many of you are aware that bound objects are like a terrible
disease you can't get rid of. I'm wondering if there is a tool in existence
that will "unbind" objects, and strip out all the (XREFNAMEHERE$)layername
entries in the object's styles, layers, etc. Any responses are appreciated.

[docsaintly]

I do not have the xrefs at my disposal so i'm stuck with how the drawings are. And yes, I understand that sometimes the name being appended to the layers etc. can help conflicts, but for me this is not the case. The xrefs as well as the regular drawing conform to the same layer names, colors, etc. etc. so i basically have 5 layers when I only need one. And yes, I understand it must be known how to handle duplicates, and I would like it to bind them to the original. I was just hoping someone else did this before so I can avoid writing this myself.

[barryf]

HI,

I see your older post.

Did you ever find that lisp that works to un-bind files?

I have tried the lisp included earlier in this post, it seems to run, but I don't know where it's writing the files out to. Did you have luck with it.

Thanks

[barryf]

Actually the code in the post did not work, it gave me an error as follows:

Command: UNBIND
Loading ...; error: extra cdrs in dotted pair on input

I'm not a programmer, just a hack user, so I don't know what its telling me.

I did find the following which did work, but again no idea where it's writing the output

;;;==UNBIND.LSP=====================================================
;;; This program "unbinds" bound xreferences
;;; removing the bound items and recreating the original file
;;;==================================================================
(prompt "\nUNBIND\nLoading ...")
(defun C:UNBIND (/ BLCK BLK_NAME EXPR WBLOK)
(setq EXPR (getvar "expert"))
(setvar "EXPERT" 4)
(setvar "CMDECHO" 0)
;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
(cond
( (and ai_dcl (listp ai_dcl))) ; it's already loaded.

( (not (findfile "ai_utils.lsp")) ; find it
(ai_abort "SPECIAL"
(strcat "Can't locate file AI_UTILS.LSP."
"\n Check support directory.")))

( (eq "failed" (load "ai_utils" "failed")) ; load it
(ai_abort "SPECIAL" "Can't load file AI_UTILS.LSP"))
)
(command "-layer" "on" "*" "thaw" "*" "unlock" "*" "S" "0" "")

(setq blk_list (ai_table "block" 14)) ; no anonymous, Xrefs or
; Xref dependents.

(setq rep 0)
(repeat (length blk_list)
(setq BLCK_NAME (nth rep blk_list))
(progn
(if (wcmatch BLCK_NAME "*$#$*");bound block

(progn
(setq head (substr BLCK_NAME 1 (str_pos "$" BLCK_NAME))
whead (strcat head "*")
fname (substr head 1 (- (strlen head) 1))
)
(setq flist (list '(-4 . "<OR")
(cons 8 whead)
(cons 2 whead)
(cons 6 whead)
(cons 7 whead)
(cons 3 whead)
'(-4 . "OR>")
)
)
(setq xsels (ssget "X" flist))
(command "wblock" fname "" "0,0" xsels "")
(command "purge" "a" "" "n")
(command "purge" "a" "" "n")
(command "purge" "a" "" "n")
(command "purge" "a" "" "n")
);end progn
);endif
);end progn
(setq rep (+ 1 rep))
);end repeat

(setvar "EXPERT" EXPR)
(prompt "\n")
(prompt "\nWBlocking complete.")
(princ)
)
(defun STR_POS (schar sstring / )
(setq ptr (strlen sstring)
ctr 0
fnd nil)
(while (and (< ctr ptr)(not fnd))
(setq ctr (+ 1 ctr))
(setq fnd (or fnd (= (substr sstring ctr 1) schar)))
);end while
(setq ctr ctr)
)