CADsite forum

Voorbeeld:
In een tekening staan 10 blocks met de naam BOOM.
Een van die blocks moet hernoemd worden naar BOOM_01

Deze functie zit wel in Civil3d ("COPYBLOCKDEFANDASSIGN") maar niet in standaard AutoCAD

;;  BlockDupNewName.lsp [command name: BDN]
;;  To make a new Block that is a Duplicate of a selected Block or WMF, with
;;    a New block Name, replacing the selected one, and which can then be
;;    edited if desired for variance(s) in content compared to the selected one,
;;    without affecting other insertions of the original Block name.
;;  Offers default new Block name = old name with "-1" added, "-2" or beyond
;;    if already used.  Accepts any typed-in new name instead; asks again if
;;    User input is already a Block name.
;;  If elements in Block definition are on Layers that are off/frozen/locked,
;;    will NOT include them in new Block definition.
;;  [When making new Block definition from WMF, all elements within seem
;;    to become 2D Plines, incl. pieces of Text characters, segmented circles, etc.
;;    Remove references to WMF in prompts if you don't want them mentioned,
;;    but will still convert them if selected.]
;;  Kent Cooper, 24 July 2012
;;  Edited by Eddy Lucas 12 Jan 2015:
;;  Changed the "(getstring ...)" in "getstring T ...)" for using a space in the blockname.


(defun C:BDN ; = Block Duplicate with New block name
  (/ *error* cmde blksel blkent blkdata blkobj blkname inc newname)


  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); end if
    (command "_.undo" "_end")
    (setvar 'cmdecho cmde)
    (princ)
  ); end defun - *error*


  (vl-load-com)
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "_.undo" "_begin")


  (prompt "\nTo convert Block/WMF into Duplicate Block with New name,")
  (while
    (not
      (and
        (setq blksel (ssget "_+.:E:S:L" '((0 . "INSERT")))); Block/Xref/WMF/Minsert, unlocked Layer
        (setq
          blkent (ssname blksel 0)
          blkdata (entget blkent); need in entity-data format for (entmake)
        ); setq
        (= (cdr (assoc 100 (reverse blkdata))) "AcDbBlockReference"); Block/Xref/WMF, not Minsert
        (= (logand 4 (cdr (assoc 70 (tblsearch "block" (cdr (assoc 2 blkdata)))))) 0); not Xref
      ); and
    ); not
    (prompt "\nNothing selected, or not a Block/WMF, or on a locked Layer.")
  ); while
  (setq
    blkobj (vlax-ename->vla-object blkent); for easier normalization below, & bounding box
    blkname (vla-get-Name blkobj)
    inc 1
  ); setq
  (while (tblsearch "block" (strcat blkname "-" (itoa inc))); already Block named that way
    (setq inc (1+ inc))
  ); while
  (setq newname (getstring T (strcat "\nNew Block name <" blkname "-" (itoa inc) ">: ")))
  (if (= newname "") (setq newname (strcat blkname "-" (itoa inc)))); User hit Enter
  (while (or (tblsearch "block" newname) (= newname ""))
    ; typed in already-used name, or after doing so, within this (while) loop, hit Enter
    (setq newname (getstring T "\nBlock name in use (or empty) -- enter different name [or Esc to exit]: "))
  ); while
  (vla-put-XScaleFactor blkobj 1); normalize insertion -- basis for new Block definition
  (vla-put-YScaleFactor blkobj 1)
  (vla-put-ZScaleFactor blkobj 1)
  (vla-put-Rotation blkobj 0)
  (vla-getboundingbox blkobj 'minpt 'maxpt)
  (command "_.zoom" (vlax-safearray->list minpt) (vlax-safearray->list maxpt))
    ; to ensure all resulting objects are found for new Block definition
  (command "_.explode" blkent )
  (command   "_.block" newname (cdr (assoc 10 blkdata)))
(command "_previous" "") ; removes entities
(command "_.zoom" "_previous")

  (entmake
    (append
      (vl-remove-if
        '(lambda (x) (member (car x) '(-1 330 5 2))); no entity names, handle, Block name
        blkdata ; keeps layer, ins. pt., scales, rotation, extr dir, any overrides
      ); remove
      (list (cons 2 newname))
    ); append
  ); entmake


  (command "_.undo" "_end")
  (setvar 'cmdecho cmde)
  (princ)
); defun


(princ "\nType BDN to convert Block/WMF into Duplicate Block with New name.")
(princ)

Hmm, ik vind dit een 'gevaarlijke' functie. Er zijn diverse problemen naast het aangehaalde, naar mijn mening onoverkomelijke, met elementen op lagen die off, frozen of locked zijn. Als de geselecteerde insert deel uitmaakt van een group kunnen onderdelen van de group in de nieuwe block definitie belanden. Ook wordt geen rekening gehouden met een eventuele 3D context.
Het is beter om gebruik te maken van de copyobjects methode om het block te klonen. Dit is niet alleen veiliger maar ook makkelijker.

Citaat van: roy_043 op di 13 01 2015, 11:53:24
Hmm, ik vind dit een 'gevaarlijke' functie. Er zijn diverse problemen naast het aangehaalde, naar mijn mening onoverkomelijke, met elementen op lagen die off, frozen of locked zijn. Als de geselecteerde insert deel uitmaakt van een group kunnen onderdelen van de group in de nieuwe block definitie belanden. Ook wordt geen rekening gehouden met een eventuele 3D context.
Het is beter om gebruik te maken van de copyobjects methode om het block te klonen. Dit is niet alleen veiliger maar ook makkelijker.

Wat is er mis met de "WYSIWYG" methode? Dit is juist het doel.
De functie is overgenomen/nagemaakt van Civil3d... dus waarom gevaarlijk?

Met een group... niet veel ervaring mee maar heb nu even een testje gedaan.
Een block uit een group selecteren...
Het nieuwe block (want dat is het) zit niet in de group, niets mis mee lijkt me.
Zelfs frozen objecten gaan mee naar het nieuwe block.

Wat bedoel je met 3D context?
En wat is jou "copyobjects" methode?

Ik zie geen problemen, nog niet... 

Vreemd dat objecten op bevroren lagen in de nieuwe definitie terechtkomen. Weet je zeker dat het niet gaat om lagen die off staan?
Heb je getest met gelockte lagen?
Heb je group select aanstaan?
Naar mijn mening is het wenselijk dat de insert onderdeel van de groep blijft.
Werk je weleens in 3D?
Zegt vla-copyobjects jou iets?

4e probleem: Draworder v.d. insert wordt gewijzigd.

Zie antwoord in rood, en houd in gedachte dat ik niet de maker van de lisp ben:

Citaat van: roy_043 op di 13 01 2015, 13:46:52
Vreemd dat objecten op bevroren lagen in de nieuwe definitie terechtkomen. Weet je zeker dat het niet gaat om lagen die off staan? ja
Heb je getest met gelockte lagen? nee
Heb je group select aanstaan? weet niet
Naar mijn mening is het wenselijk dat de insert onderdeel van de groep blijft. je maakt een nieuw object en je verwijderd een oud object, deze moet je dan zelf weer in de group zetten of zelf de lisp aanpassen dat het weer in de group komt
Werk je weleens in 3D? ja zeker anders hoef ik niet met civil3d te werken
Zegt vla-copyobjects jou iets? ja, vla moet je eten...  maar vla-copyobjects heb ik nog niet gebruikt in mn lisps

4e probleem: Draworder v.d. insert wordt gewijzigd. natuurlijk, maakt een nieuw object dus die komt helemaal boven

Wat betreft '3D context': Het programma werkt alleen goed als het huidige UCS overeenkomt met het OCS van de insert. Je kunt dit controleren door terwijl het WCS actief een insert te plaatsen, vervolgens het UCS om de Z-as te roteren en dan het programma te gebruiken.