Topic: Combining multiple blocks and renaming group block

[ELOQUINTET]

Nevermind I got it. I added this into the bname part.

Code: [Select]

bname (vl-string-subst "_" "." bname)

[ELOQUINTET]

Hey CAB The routine I requested from you is what I am using to create my elevation group blocks. I thought I would be able to modify the code to work with my plan blocks but there are a few differences I'm not sure how to deal with.:

1) I have 3 blocks and instead of containing text they contain attributes
2) I have the left side and right as blocks so that I can extract the attributes for cost reports

I figured these changes out:

3) The layer is different
4) The prefixes have changed from elev_ and elevgroup_ to plan_ and plangroup_

I'm getting this error when selecting the subblock and I'm guessing it's because this block only has an _L and not _LR like the other ones. How can I have it only strip off the _L. I don't really even need to select the right side as the root is the same?


Select sub block for name.; error: bad argument type: numberp: nil

Code: [Select]

(defun c:PB (/ bent bname bname2  pos pt ss)
  (setvar "clayer" "V-EXTRACT-NEW")
  (if
    (and
      (setq bent (entsel "\nSelect main block for name."))
      (setq bname (cdr (assoc 2 (entget (car bent))))
            ;; bname (strcase bname)
            bname (vl-string-subst "plangroup_" "plan_" bname)
            bname (vl-string-subst "_" "." bname)
            bname (vl-string-subst "" "_M" bname)
      )
      (setq bent2 (entsel "\nSelect sub block for name."))
      (setq bname2 (cdr (assoc 2 (entget (car bent2))))
            bname2 (strcase bname2)
            pos    (vl-string-position (ascii ".") bname2)
            bname2 (substr bname2 (+ pos 2))
            pos    (vl-string-position (ascii "_") bname2)
            bname2 (substr bname2 1 pos)
            bname  (strcat bname "_" bname2)
      )
      (princ "\nSelect objects to makup the new block.")
      (setq ss (ssget))
      (setq pt (getpoint "\nPick Insert point."))
    )
     (command "-block" bname "non" pt ss ""
              "-insert" bname "non" pt "" "" "")
  )
  (princ)
)code]

[CAB]

Maybe something in the block names.
Upload a sample of these blocks.

[ELOQUINTET]

Whoops sorry I meant to originally but forgot. You will see that this assembly will consist of 3 sub blocks. If you look you will see that I really only need the core from the center and left like the other so getting the other block info is not neccesary as it's the same except for the end. Anyway take a look and tell me what you think.

[CAB]

This should work with both block combinations plan_PK-07 or elev_PK-07.
Is PK-07 a given?

Code: [Select]

;;  CAB 04.22.08
;;  Combine blocks using combined names
;;  Dependant on block name starting with  plan_PK-07 or elev_PK-07
(defun c:PB (/ bent bent2 bname bname2 pt ss LibPrefix *error*)
  (defun *error* (msg)
    (if (not
          (member msg  '("console break" "Function cancelled" "quit / exit abort" "")))
       (princ (strcat "\nError: " msg))
    )
    (and bent (redraw (car bent) 4))
    (and bent2 (redraw (car bent2) 4))
    (princ)
  ) ; end error function

  (setq LibPrefix "PK-07")

 
  (if
    (and
      (setq bent (entsel "\nSelect main block for name."))
      (null (redraw (car bent) 3))
      (setq bname (cdr (assoc 2 (entget (car bent)))))
      (cond
        ((wcmatch bname "plan_*")
          (setq bname (vl-string-subst "plangroup_" "plan_" bname))
         (setvar "clayer" "V-EXTRACT-NEW")
         )
        ((wcmatch bname "elev_*")
          (setq bname (vl-string-subst "elevgroup_" "elev_" bname))
         (setvar "clayer" "0")
         )
      )
      (setq bname (vl-string-subst "_" "." bname) ; change . to _
            bname (vl-string-right-trim "_M" bname) ; remove M & _
      )
      (setq bent2 (entsel "\nSelect sub block for name."))
      (null (redraw (car bent2) 3))
      (setq bname2 (cdr (assoc 2 (entget (car bent2)))))
      (cond
        ((wcmatch bname2 "plan_*")
          (setq bname2 (vl-string-subst "" (strcat "plan_" LibPrefix) bname2)) ; remove the prefix
         )
        ((wcmatch bname2 "elev_*")
          (setq bname2 (vl-string-subst "" (strcat "elev_" LibPrefix) bname2)) ; remove the prefix
         )
      )
      (setq bname2 (vl-string-right-trim "_LR" bname2) ; remove suffix _, L, R
            bname2 (vl-string-left-trim "_." bname2) ; remove prefix _ or .
            bname  (strcat bname "_" bname2)
      )
      (princ "\nNew Block Name ")
      (princ bname)
      (princ "\nSelect objects to makup the new block.")
      (setq ss (ssget))
      (setq pt (getpoint "\nPick Insert point."))
    )
     (command "-block" bname "non" pt ss ""
              "-insert" bname "non" pt "" "" ""
             )
  )
  (*error* "")
  (princ)
)

[ELOQUINTET]

Actually now that you mention it CAB PK-07 is the library prefix (Polo Kids 2007) which will change on the next one I do. I thought about it but there is a design period between each usually so I thought it could be incorporated during that lag time. If you have any thoughts about how to do that then by all means go for it. To be honest, I don't really know all of the coding variables as I have not been here long enough to know all of the libraries and options but I do understand the core structure of it so that's a start. I know that almost all libraries have wall cases and this is the standard we are trying to establish so that's why I started with these. Anyway thanks for your help I'll give this a try this morning.

[CAB]

I updated the code with the library prefix as a variable.

[ELOQUINTET]

Hey CAB how would I make it so that if it found a prefix of elev_ it would set the layer to "0" whereas if it found a prefix of plan_ it would set the current layer to "V-EXTRACT-NEW" ?

[CAB]

I changed the code again.

[ELOQUINTET]

CAB I learned last night that my hunch was not correct as far as the plan blocks are concerned. I assumed that the block names would be the same as the elevations but this is not the case. Basically for the plans instead of having plan_ for the nested blocks and plangroup_ for the assembly block all of the plan blocks only have an _ as the prefix. I tried to modify the code but screwed up somewhere along the way. I'm getting a too few arguments error when selecting the sub block? I changed the syntax in the layer trigger section and removed the prefix removal part for the plans. I'm not sure if it would be easier to edit mine or your but just posted it to show that I am trying to figure this out on my own 

Code: [Select]

;;  Dependant on block name starting with  plan_PK-07 or elev_PK-07
(defun c:CBLOCK (/ bent bent2 bname bname2 pt ss LibPrefix *error*)
  (defun *error* (msg)
    (if (not
          (member msg  '("console break" "Function cancelled" "quit / exit abort" "")))
       (princ (strcat "\nError: " msg))
    )
    (and bent (redraw (car bent) 4))
    (and bent2 (redraw (car bent2) 4))
    (princ)
  ) ; end error function

  (setq LibPrefix "PK-07")

 
  (if
    (and
      (setq bent (entsel "\nSelect main block for name."))
      (null (redraw (car bent) 3))
      (setq bname (cdr (assoc 2 (entget (car bent)))))
      (cond
        ((wcmatch bname "_*")
          (setq bname (vl-string-subst "_" bname))
         (setvar "clayer" "V-EXTRACT-NEW")
         )
        ((wcmatch bname "elev_*")
          (setq bname (vl-string-subst "elevgroup_" "elev_" bname))
         (setvar "clayer" "0")
         )
      )
      (setq bname (vl-string-subst "_" "." bname) ; change . to _
            bname (vl-string-right-trim "_M" bname) ; remove M & _
      )
      (setq bent2 (entsel "\nSelect sub block for name."))
      (null (redraw (car bent2) 3))
      (setq bname2 (cdr (assoc 2 (entget (car bent2)))))
      (cond
        ((wcmatch bname2 "elev_*")
          (setq bname2 (vl-string-subst "" (strcat "elev_" LibPrefix) bname2)) ; remove the prefix
         )
      )
      (setq bname2 (vl-string-right-trim "_LR" bname2) ; remove suffix _, L, R
            bname2 (vl-string-left-trim "_." bname2) ; remove prefix _ or .
            bname  (strcat bname "_" bname2)
      )
      (princ "\nNew Block Name ")
      (princ bname)
      (princ "\nSelect objects to makup the new block.")
      (setq ss (ssget))
      (setq pt (getpoint "\nPick Insert point."))
    )
     (command "-block" bname "non" pt ss ""
              "-insert" bname "non" pt "" "" ""
             )
  )
  (*error* "")
  (princ)
)

[CAB]

Dan, I do better with a DWG example. Can you post one?

[ELOQUINTET]

Ah OK actually I had a meeting with my boss and learned a few things that are different

If you look at the ungrouped blocks at the bottom you will see that their is no underscore before the M now for the middle case case

If you look at the The ungrouped plan blocks now only have and underscore prefix not plan_
Also the grouped block name now has a prefix of group" instead of plangroup_

On a side note, I discovered through testing that the routine acts a little crazy if the block has already been defined in the drawing. This is not a big deal as I just purge it out then all is well, just wanted to let you know.

[ELOQUINTET]

O my I just realized after all that I forgot to attach the drawing, Genius. TGIF  :ugly:

[CAB]

So this is your final?

[CAB]

Test this:

Code: [Select]

;;  CAB 04.25.08
;;  Combine blocks using combined names
;;  Dependant on block name starting with  plan_PK-07 or elev_PK-07
(defun c:CBlock (/ bent bent2 bname bname2 pt ss LibPrefix *error*)
  (defun *error* (msg)
    (if (not
          (member msg  '("console break" "Function cancelled" "quit / exit abort" "")))
       (princ (strcat "\nError: " msg))
    )
    (and bent (redraw (car bent) 4))
    (and bent2 (redraw (car bent2) 4))
    (princ)
  ) ; end error function

  (setq LibPrefix "PK-07")

 
  (if
    (and
      (setq bent (entsel "\nSelect main block for name."))
      (null (redraw (car bent) 3))
      (setq bname (cdr (assoc 2 (entget (car bent)))))
      (cond
        ((wcmatch bname "_*") ; plan view
          (setq bname (vl-string-subst "group_" "_" bname))
         (setvar "clayer" "V-EXTRACT-NEW")
         )
        ((wcmatch bname "elev_*")
          (setq bname (vl-string-subst "elevgroup_" "elev_" bname))
         (setvar "clayer" "0")
         )
      )
      (setq bname (vl-string-subst "_" "." bname) ; change . to _
            bname (vl-string-right-trim "_M" bname) ; remove M & _
      )
      (setq bent2 (entsel "\nSelect sub block for name."))
      (null (redraw (car bent2) 3))
      (setq bname2 (cdr (assoc 2 (entget (car bent2)))))
      (cond
        ((wcmatch bname2 "_*")
          (setq bname2 (vl-string-subst "" (strcat "_" LibPrefix) bname2)) ; remove the prefix
         )
        ((wcmatch bname2 "elev_*")
          (setq bname2 (vl-string-subst "" (strcat "elev_" LibPrefix) bname2)) ; remove the prefix
         )
      )
      (setq bname2 (vl-string-right-trim "_LRM" bname2) ; remove suffix _, L, R, M
            bname2 (vl-string-left-trim "_." bname2) ; remove prefix _ or .
            bname  (strcat bname "_" bname2)
      )
      (princ (strcat "\nNew Block Name \"" bname "\""))
      (princ "\nSelect objects to makup the new block.")
      (setq ss (ssget))
      (setq pt (getpoint "\nPick Insert point."))
    )
    (if (and ss pt (listp pt))
      (if (tblsearch "BLOCK" bname)
        (alert "Block Combo already exist.")
        (command "-block" bname "non" pt ss ""
                 "-insert" bname "non" pt "" "" "")
      )
    )
  )
  (*error* "")
  (princ)
)