Create new block from existing one

 I am looking for a way to quickly create a new block from an existing block (like the "make unique" function in SketchUp, for those familiar with it).

From a google search, it seems that Autocad may have a "save as" function in its block editor which would do this.  But REFEDIT in Bcad does not seem to have anything like this.

Other than a lisp routine (which I may be able to piece together) is there a more direct way to accomplish this?

Comments

  • For a real quick solution, I would use COPYCLIP to "save" the block into memory, then rename the block definition in Bricscad, and then paste your previously copied block back into the drawing using PASTECLIP.
  • That's brilliant. I was doubtful it would work, but it does.
  • Here is a lisp routine I found online -- it seems to work fine in BCAD and does what I wanted.

    Thanks for the replies -- hope this might be useful to anyone else needing the same thing.

    [code];;; CBQ (gile) 2007/05/05
    ;;; Creates a new block definition similar to the selected reference

    (defun c:cbq (/ old-ref new-name AcDoc Space Blocks old-name old-block new-block
         obj new-ref)
      (vl-load-com)
      (while (not
      (and
        (setq old-ref (car (entsel "\nSelect the block to re-create: ")))
        (= "INSERT" (cdr (assoc 0 (entget old-ref))))
      )
    )
        (princ "\nInvalid object.")
      )
      (while
        (not
          (and
    (setq
     new-name (getstring T "\nEnter the new block name: ")
    )
    (/= new-name "")
    (null (tblsearch "BLOCK" new-name))
          )
        )
         (princ "\nInvalid name.")
      )
      (setq AcDoc  (vla-get-ActiveDocument (vlax-get-acad-object))
    Space  (if (= (getvar "CVPORT") 1)
       (vla-get-PaperSpace AcDoc)
       (vla-get-ModelSpace AcDoc)
     )
    Blocks  (vla-get-Blocks acDoc)
    old-ref  (vlax-ename->vla-object old-ref)
    old-name  (if (vlax-property-available-p old-ref 'EffectiveName)
       (vla-get-EffectiveName old-ref)
       (vla-get-name old-ref)
     )
    old-block (vla-item Blocks old-name)
    new-block (vla-add Blocks
      (vlax-3d-point '(0 0 0))
      new-name
     )

      )
      (vlax-for o old-block
        (setq obj (cons o obj))
      )
      (vlax-invoke AcDoc 'CopyObjects obj new-block)
      (and (vlax-property-available-p old-block 'Units)
           (vla-put-Units new-block (vla-get-Units old-block))
      )
      (setq new-ref
    (vla-insertblock
      Space
      (vlax-3d-point '(0 0 0))
      new-name
      (vla-get-XScaleFactor old-ref)
      (vla-get-YScaleFactor old-ref)
      (vla-get-ZScaleFactor old-ref)
      (vla-get-Rotation old-ref)
    )
      )
      (vla-put-Normal new-ref (vla-get-Normal old-ref))
      (vla-put-InsertionPoint
        new-ref
        (vla-get-InsertionPoint old-ref)
      )
      (if (= (vla-get-HasAttributes old-ref) :vlax-true)
        (progn
          (setq old-att (mapcar '(lambda (att) (cons (vla-get-TagString att) att))
       (vlax-invoke old-ref 'getAttributes)
       )
       new-att (mapcar '(lambda (att) (cons (vla-get-TagString att) att))
       (vlax-invoke new-ref 'getAttributes)
       )
          )
          (foreach att new-att
    (foreach prop (list
    'Alignment   'Backward  'Color       'FieldLength
    'Height     'InsertionPoint       'Invisible
    'Layer     'TextString  'Linetype    'LinetypeScale
    'Lineweight  'Material  'Normal      'ObliqueAngle
    'Rotation    'ScaleFactor 'StyleName   'TextString
    'Thickness   'TrueColor  'UpsideDown  'Visible
          )
     (if (vlax-property-available-p
    (cdr (assoc (car att) old-att))
    prop
         )
       (vlax-put (cdr att)
         prop
         (vlax-get (cdr (assoc (car att) old-att)) prop)
       )
     )
    )
          )
        )
      )
      (vla-delete old-ref)
      (princ (strcat "The block \"" new-name "\" has been created."))
      (princ)
    )
    [/code] 
This discussion has been closed.