Topic: Explode all xrefs after binding them

[GDF]

Goal is to bind insert all xrefs in a drawing and then explode them.
The xrefs name begin with either a BL or UT.

The following code works, but not very well...looking for something better.

Have to run this multiply times to get them all: (command "explode" (ssget "_x" '((2 . "BL*,UT*"))))

Code: [Select]

(defun ARCH:ToggleXrefs-Bind (searchstr / tbldata table_list xrefs match cnt un/load)
  (setq tbldata   nil
 xrefs   '()
 searchstr (strcase searchstr)
  )

  ;;find all the xrefs in drawing
  (while (setq tbldata (tblnext "BLOCK" (not tbldata)))
    (if (= 4 (logand 4 (cdr (assoc 70 tbldata))))
      (setq xrefs (cons (strcase (cdr (assoc 2 tbldata))) xrefs))
    )
  )

  ;;find the first match, if any, for search string
  (setq cnt 0)
  (while (and xrefs (not match) (< cnt (length xrefs)))
    (if (wcmatch (nth cnt xrefs) searchstr)
      (setq match (nth cnt xrefs))
    )
    (setq cnt (1+ cnt))
  )

  ;;if a match was found then go ahead
  (if match
    (progn
      ;;assumes the state of the first match is same for all matching xrefs
      (setq un/load (if (assoc 71 (entget (tblobjname "block" match)))
        "Reload"
        "Bind"
      )
      )
      ;;do the deed
      (princ (strcat "\n" un/load "ing " searchstr))
      (command "-xref" un/load searchstr)
    )
    ;;no match found
    (princ "\nNo valid xrefs in drawing.")
  )
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(ARCH:ToggleXrefs-Bind "BL*")
;;(ARCH:ToggleXrefs-Bind "UT*")

(defun C:Test ()
  (ARCH:ToggleXrefs-Bind "BL*")
  ;;(ARCH:ToggleXrefs-Bind "UT*")
  ;;(setq ss (ssget "_x" '((2 . "BL*,UT*"))))
  (command "explode" (ssget "_x" '((2 . "BL*,UT*")))) 
)


[GDF]

This is clunky and runs out of memory in large drawings.

Code: [Select]

(defun XBLDG  (/ sel i ent n_ent) 
  (setq sel (ssget "_x" '((2 . "BL*"))))
  (setq i 0)
  (setq n_ent (sslength sel))
  (repeat n_ent (command "_explode" (ssname sel i)) (setq i (+ 1 i)))
  )

(defun XUNIT  (/ sel i ent n_ent) 
  (setq sel (ssget "_x" '((2 . "UT*"))))
  (setq i 0)
  (setq n_ent (sslength sel))
  (repeat n_ent (command "_explode" (ssname sel i)) (setq i (+ 1 i)))
  )

(defun C:Test  (/ bt)
  (setq bt (getvar "bindtype"))
  (setvar "bindtype" 1)
  (command "-xref" "b" "*")
  (XBLDG)
  (XUNIT)
  (setvar "bindtype" bt))


[VovKa]

Code: [Select]

(sssetfirst nil (ssget "_X" '((0 . "INSERT") (2 . "BL*,UT*"))))
(command "._EXPLODE")


[GDF]

Thanks VovKa

I think the routine below works ok now. The problem I was having is that the unit plans "UT*" are nested xrefs in the building plans "BL*".
I first have to bind insert the building plans and expode them, then explode the unit plans.

My goal is to create CAD backgrounds for noncontractural consultants. This way we can deliver to them easy to use cleaned up purged backgrounds that are locked down with the deter routine. This protects us from having the backgrouds that are easily modified but to still easy to use.

The routine below speeds up this process since the the overall profile backgrounds can contain half a dozen building plans each made up of dozens of unit plans. I just wanting some feedback from you guys to see if there was a better way of doing this.

Thanks again.

Code: [Select]

(defun C:CadBackgrounds  (/ bt xunit xbldg)
  (defun XBLDG  (/ sel i ent n_ent)
    (setq sel (ssget "_X" '((0 . "INSERT") (2 . "BL*"))))
    (setq i 0)
    (setq n_ent (sslength sel))
    (repeat n_ent (command "._explode" (ssname sel i)) (setq i (+ 1 i))))  
  (defun XUNIT  (/ sel i ent n_ent)
    (setq sel (ssget "_X" '((0 . "INSERT") (2 . "UT*"))))
    (setq i 0)
    (setq n_ent (sslength sel))
    (repeat n_ent (command "._explode" (ssname sel i)) (setq i (+ 1 i))))
  (setq bt (getvar "bindtype"))
  (setvar "bindtype" 1)
  (command "-xref" "b" "*")
  (XBLDG)  
  (XUNIT)
  (setvar "bindtype" bt))


[VovKa]

try it

Code: [Select]

(defun C:CadBackgrounds  (/ bt)
  (setq bt (getvar "bindtype"))
  (setvar "bindtype" 1)
  (command "-xref" "b" "*")
  (sssetfirst nil (ssget "_X" '((0 . "INSERT") (2 . "BL*,UT*"))))
  (command "._EXPLODE")
  (setvar "bindtype" bt))


[GDF]

try it

Code: [Select]

(defun C:CadBackgrounds  (/ bt)
  (setq bt (getvar "bindtype"))
  (setvar "bindtype" 1)
  (command "-xref" "b" "*")
  (sssetfirst nil (ssget "_X" '((0 . "INSERT") (2 . "BL*,UT*"))))
  (command "._EXPLODE")
  (setvar "bindtype" bt))


It stops midway and asks for a selection. It doesnot get the units "UT*".

[GDF]

My next question is how would I modify ARCH:DeleteLayer to allow for wildcard layer names?
For example all layers having the following name: A-SYMB* where the varable layer_name can be used as a wild card.

Code: [Select]

(defun ARCH:DeleteLayer  (layer_name / n ent acapp acsp adoc allrs layer_name TotalNumber
                          CurrNumber)
  (vl-load-com)
  (setq n 1)
  (setq acapp (vlax-get-acad-object)
        adoc  (vla-get-activedocument acapp)
        acsp  (vla-get-block (vla-get-activelayout adoc))
        allrs (vla-get-layers adoc))
  (setq TotalNumber
         (sslength (ssget "_X" (list (cons 8 layer_name))))
        CurrNumber 1)
  (if (member "acetutil.arx" (arx))
    (ACET-UI-PROGRESS-INIT
      "Please Wait while the Program is Running"
      TotalNumber))
  (or (eq (vla-get-freeze (vla-item allrs layer_name)) :vlax-true)
      (vla-put-freeze (vla-item allrs layer_name) :vlax-false))
  (or (eq (vla-get-lock (vla-item allrs layer_name)) :vlax-true)
      (vla-put-lock (vla-item allrs layer_name) :vlax-false))
  (or (eq (vla-get-layeron (vla-item allrs layer_name)) :vlax-false)
      (vla-put-layeron (vla-item allrs layer_name) :vlax-true))
  (vlax-for
         lt  (vla-get-layouts adoc)
    (vlax-for
           ob  (vla-get-block lt)
      (if (eq (vla-get-layer ob) layer_name)
        (progn (if (member "acetutil.arx" (arx))
                 (ACET-UI-PROGRESS-SAFE n))
               (setq n (+ n 1))
               (vla-delete ob)
               (vlax-release-object ob)))))
  (if (member "acetutil.arx" (arx))
    (ACET-UI-PROGRESS-DONE))
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun CadBackgrounds-it  (/ sel1 sel2 bt xunit xbldg)
  ;;(ARCH:WORKING)
  (setq n 1)
  (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-INIT
    "Please Wait while the Program is Running"
    (length rtnList)))
  (setq sel1 (ssget "_X" '((0 . "INSERT") (2 . "BL*"))))
  (defun XBLDG  (/ i ent n_ent) ;(setq sel1 (ssget "_X" '((0 . "INSERT") (2 . "BL*"))))
    (setq i 0)
    (setq n_ent (sslength sel1))
    (repeat n_ent
      (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-SAFE n))
      (setq n (+ n 1))
      (command "._explode" (ssname sel1 i))
      (setq i (+ 1 i))))
  (defun XUNIT  (/ i ent n_ent)
    (setq sel2 (ssget "_X" '((0 . "INSERT") (2 . "UT*"))))
    (setq i 0)
    (setq n_ent (sslength sel2))
    (repeat n_ent
      (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-SAFE n))
      (setq n (+ n 1))
      (command "._explode" (ssname sel2 i))
      (setq i (+ 1 i))))
  (setq bt (getvar "bindtype"))
  (setvar "bindtype" 1)
  (command "-xref" "b" "*")
  (if (/= sel1 nil)
    (XBLDG))
  (XUNIT)
  (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE))
  (setvar "bindtype" bt)
  (C:ON)
  (C:THW)
  (ARCH:DeleteLayer "A-AREA")
  (ARCH:DeleteLayer "A-DIMS") 
  ;(ARCH:DeleteLayer "A-FURN")
  (ARCH:DeleteLayer "A-HC")
  ;(ARCH:DeleteLayer "A-PLFL-PATT")
  (ARCH:DeleteLayer "A-NOTE")
  (ARCH:DeleteLayer "A-NOTE-LDR")
  (ARCH:DeleteLayer "A-PATT")
  (ARCH:DeleteLayer "A-PATT-POCH")
  (ARCH:DeleteLayer "A-SHTT-DATA")
  (ARCH:DeleteLayer "A-SYMB")
  (ARCH:DeleteLayer "A-SYMB-DOOR")
  ;(ARCH:DeleteLayer "A-SYMB-IDEN")
  ;(ARCH:DeleteLayer "A-SYMB-LBRK")
  ;(ARCH:DeleteLayer "A-SYMB-MARK")
  ;(ARCH:DeleteLayer "A-SYMB-MTCH")
  (ARCH:DeleteLayer "A-SYMB-PART")
  (ARCH:DeleteLayer "A-SYMB-ROOM")
  (ARCH:DeleteLayer "A-SYMB-WDW")
  ;(ARCH:DeleteLayer "A-WALL-PATT")
  (ARCH:DeleteLayer "E-POWR-NOTE")
  (ARCH:DeleteLayer "DEFPOINTS")
  (C:XS)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun CadBackgroundsit  (/ result)
  (setq Result (ARCH:WARNING-5
                 "Create CAD Backgrounds"
                 "     Warning this will Bind, Explode and Purge ALL Xrefs.\n"
                 "     Make sure this is NOT the Original Drawing!!!\n\n"
                 "     [ Yes ]\t  to continue on...\n" "     [ No ]\t  to cancel." ""))
  (cond ((= 0 Result) (CadBackgrounds-it))
        ((= 1 Result)
         (princ "\n*** ///////// Program  CANCELLED ///////// ***")))
  (princ))


[VovKa]

Code: [Select]

(vl-cmdf "._-PURGE" "_LA" "A-SYMB*" "_N")


[GDF]

Code: [Select]

(vl-cmdf "._-PURGE" "_LA" "A-SYMB*" "_N")


That's a good one for unreferenced layers. What I'm looking for is to deleted all objects on that layer "a referenced layer".

[VovKa]

i guess there is a special command in express tools.
can't tell exactly, because i do not have express tools installed on my pc

[alanjt]

Code: [Select]

(vl-cmdf "._-PURGE" "_LA" "A-SYMB*" "_N")


That's a good one for unreferenced layers. What I'm looking for is to deleted all objects on that layer "a referenced layer".

Something like this will delete everything on the specified layer and 'purge' it from drawing.

Code: [Select]

(defun LayerNuke (#LayerName / #Layers #Layer #SS)
  (setq #Layers (vla-get-layers
                  (vla-get-activedocument
                    (vlax-get-acad-object)
                  ) ;_ vla-get-activedocument
                ) ;_ vla-get-layers
  ) ;_ setq
  (if (tblsearch "layer" #LayerName)
    (progn
      (setq #Layer (vla-item #Layers #LayerName))
      (or (not (eq (getvar "clayer") #LayerName))
          (progn
            (vla-put-freeze (vla-item #Layers "0") :vlax-false)
            (setvar "clayer" "0")
          ) ;_ progn
      ) ;_ or
      (vla-put-freeze #Layer :vlax-false)
      (vla-put-lock #Layer :vlax-false)
      (and (setq #SS (ssget "_X" (list (cons 8 #LayerName))))
           (mapcar
             '(lambda (x) (vla-delete (vlax-ename->vla-object (cadr x))))
             (ssnamex #SS)
           ) ;_ mapcar
      ) ;_ and
      (not (vla-delete #Layer))
    ) ;_ progn
  ) ;_ if
) ;_ defun


[GDF]

Thanks alan

here is how I am deleting the layers and nuking all objects on that layer:
http://www.theswamp.org/index.php?topic=30375.0

[alanjt]

Thanks alan

here is how I am deleting the layers and nuking all objects on that layer:
http://www.theswamp.org/index.php?topic=30375.0

No problem, I was responding to your veto of the use of command-purge.

[GDF]

Here is the updated code (still a work in progress).

Thanks everyone for the tips and help.