Unbind XRefs

[irneb]

OK, here I go with a problem consultant who refuses to use eTransmit. He's got his own bind routine and he'll stick to it no matter what!

 

The problem is it becomes an enormous task trying to clean his drawings (what with 100's if not 1000's of layers, linetypes, styles, etc. all with that blockname$0$layername naming scheme).

 

So my idea was to wblock each of these blocks if their internals are on one of these layers. Then use the Express tool BlockToXRef to change the block into a true xref. That's all good an fine, only I still have those irritating layers, styles, linetypes, dimstyles, mleaderstyles, etc. etc. etc.

 

Now the rename / merge of layers works fine, there's several samples of such even on this site, and I've done one previously on AUGI's site. So at first I thought, styles shouldn't be too difficult should it?

 

Well, here's my code thus far ... using vl (because I just don't care to make it portable anymore ) :

(vla-load-com)
(setq *ActiveDoc* (vla-get-ActiveDocument (vlax-get-acad-object))
     *BlocksCol* (vla-get-Blocks *ActiveDoc*)
)

;;; Rename / Merge Bound $ layers
(defun c:CleanLayers (/ lay name old new blk eo)
 (or *LayersCol* (setq *LayersCol* (vla-get-Layers *ActiveDoc*)))
 (while (setq lay (tblnext "LAYER" (not lay)))
   (setq name (cdr (assoc 2 lay)))
   (if (wcmatch name "*$*")
     (progn
       (while (wcmatch name "*$*")
         (setq name (substr name (+ (vl-string-search "$" name) 2)))
       )
       (if (tblsearch "LAYER" name)
         (setq old (cons (cdr (assoc 2 lay)) old)
               new (cons name new)
         )
         (vla-put-Name (vla-Item *LayersCol* (cdr (assoc 2 lay))) name)
       )
     )
   )
 )
 (if old
   (vlax-for blk *BlocksCol*
     (vlax-for eo blk
       (if (setq lay (vl-position (vla-get-Layer eo) old))
         (vla-put-Layer eo (nth lay new))
       )
     )
   )
 )
 (princ)
)

;;; Rename / Merge Bound $ text styles
(defun c:CleanStyles (/ sty name old new blk eo)
 (while (setq sty (tblnext "STYLE" (not sty)))
   (setq name (cdr (assoc 2 sty)))
   (if (wcmatch name "*$*")
     (progn
       (while (wcmatch name "*$*")
         (setq name (substr name (+ (vl-string-search "$" name) 2)))
       )
       (if (tblsearch "LAYER" name)
         (setq old (cons (cdr (assoc 2 sty)) old)
               new (cons name new)
         )
         (vla-put-Name (vla-Item (vla-get-TextStyles *ActiveDoc*) (cdr (assoc 2 sty))) name)
       )
     )
   )
 )
 (if old
   (vlax-for blk *BlocksCol*
     (if (not (wcmatch (vla-get-Name blk) "`*D*"))
       (vlax-for eo blk
         (if (and (wcmatch (strcase (vla-get-ObjectName eo)) "*TEXT,*ATTRIBUTE*")
                  (setq sty (vl-position (vla-get-StyleName eo) old))
             )
           (vla-put-StyleName eo (nth sty new))
         )
       )
     )
   )
 )
 (princ)
)

It's not generalized yet, first wanted it to work before I go and combine the code to remove duplication.

 

The problem is what about the text style to merge when there are stuff like DimStyles, TableStyles, MLeaderStyles, etc. referring to that?

 

Anyone have a clue or some samples on how to do this reasonably easily?

[Lee Mac]

I haven't properly looked over your code, but one thing that immediately jumps out is that you are attempting to rename a TextStyle using the 'name' property. The 'name' property is read-only for a TextStyle so the style will need to be renamed using entmod on the tblobjname entity or otherwise.

 

I was recently discussing this at theSwamp, here.

[irneb]

Oh! Yes thanks . I actually did see that post before, just didn't sink in I guess! Will have to look at using the entmod instead. But that's a side issue, thanks for pointing it out ... otherwise I'd have run into it later.

 

What I'm after is doing something similar to setting every text-like thing to the "correct" stylename if it already exists. I'm just trying to find if someone's got such code / sample before I go and hack into each type of table/dictionary where such a style might be linked to as well.