Hey CAB,
You did some coding for me awhile ago that I am now needing to modify slightly, I hope. It was a routine that would strip prefixes and suffixes off of blocks and take that and apply it as the name of an assembly block. Well I have been told to make some changes to the way the blocks are organized and named and this has made the routine not work anymore and I'm hoping we can modify it to suite the new way. I have attached a sample file with the old and new way and the original code. Can you have a look and let me know how hard this would be to modify. Thanks
;; CAB 04.25.08
;; Combine blocks using combined names
;; Dependant on block name starting with plan_"Library Prefix" or elev_"Library Prefix"
(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 ; reset if routine is cancelled
(setq LibPrefix "PK-07") ; This can be modified to suit different libraries
(if
(and
(setq bent (entsel "\nSelect Middle block for name.")) ; Get name of Middle block
(null (redraw (car bent) 3))
(setq bname (cdr (assoc 2 (entget (car bent)))))
(cond
((wcmatch bname "_*") ; If Block name starts with _ substitute _ with group_
(setq bname (vl-string-subst "group_" "_" bname))
(setvar "clayer" "V-EXTRACT-NEW") ; Set current layer to V-EXTRACT-NEW
)
((wcmatch bname "elev_*") ; If Block name starts with elev_ substitute elev_ with elevgroup_
(setq bname (vl-string-subst "elevgroup_" "elev_" bname))
(setvar "clayer" "0") ; Set current layer to 0
)
)
(setq bname (vl-string-subst "_" "." bname) ; Change . after series number to _
bname (vl-string-right-trim "_M" bname) ; remove _M from end of middle block name
)
(setq bent2 (entsel "\nSelect Side block for name."))
(null (redraw (car bent2) 3))
(setq bname2 (cdr (assoc 2 (entget (car bent2)))))
(cond
((wcmatch bname2 "_*") ; Remove _ and Library prefix "PK-07"
(setq bname2 (vl-string-subst "" (strcat "_" LibPrefix) bname2))
)
((wcmatch bname2 "elev_*") ; Remove elev_ and Library prefix "PK-07"
(setq bname2 (vl-string-subst "" (strcat "elev_" LibPrefix) bname2))
)
)
(setq bname2 (vl-string-right-trim "_LRM" bname2) ; remove suffixes of _M _L _R from side block name
bname2 (vl-string-left-trim "_." bname2) ; remove _ or . from side block name
bname (strcat bname "_" bname2) ;add _ before side block name
)
(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)
)
