select+block

Discussion in 'AutoCAD' started by orange, Aug 14, 2007.

  1. orange

    orange Guest

    I need to do this (if possible):
    -select several objects at once
    -replace each of them with a (pre-defined) block

    can you help me?
     
    orange, Aug 14, 2007
    #1
  2. orange

    Mr. B Guest

    I wrote a LISP routine a while back that I use to eXCHNGe blocks. It helps if
    tou first have to have the New block in your drawing (or you can type it in as
    long as it's in your Search Patch).

    And be carefull that the Original Block sizes match (ie: 1:1 before you insert
    them). Other wise you'll end up with different insert sizes.

    Then select the existing blocks you want ot Exchange. It maintains your
    original Block insert Point, Scale and Layer.

    You have two Options when you run the routine... 1: is to select the New
    Symbol via screen pick. 2: is to either accept a previous selected Block
    name... or type one in.

    One thing though, now and the routine doesn't see that you have selected a
    file with the 1 option. I just rerun the routine and select 2 and you'll see
    that it did indeed find your screen selection. Or just reload the LSP file
    and try again....

    Oh... and if your original symbol has an Atrribute, and you want to replace
    the same symbol with another having a different Attribute text, this will do
    that too...

    Anyways... good luck and I hope this is what you need...

    ps: watch out for Word Wrap issues on the lines....


    O/______________________________________ cut here _________________________
    0\

    ;; Exchanges existing symbols for a User defined new
    ;; one. Routine Searches Autocad PATH defaults or
    ;; gets Blocks from Drawing Data Base.


    ; ERROR MESSAGE ***********
    (defun *error* ( s )
    (setvar "clayer" curlyr) ;reset working layer
    (princ) (princ "\n ")
    (princ) (terpri)
    )


    (defun dxf (code elist)
    (cdr (assoc code elist))
    );dxf


    ; **** GET NEW SYMBOL OFF SCREEN ****
    ; ***********************************
    (defun screen_symb ( )
    (princ "\n--> Use a WINDOW selection to Pick the NEW Symbol!! <--")
    (princ "\nChoose -ONE- Symbol from Screen Selection to change to: ")
    (setq AttPick (ssget (list (cons 0 "insert"))))

    (setq ename (ssname AttPick 0))
    (setq elist (entget ename))
    (setq newAttnam nil)
    (setq newAttscl nil)
    (setq newAtt (dxf 2 elist)) ;block name
    (setq newAttscl (dxf 41 elist)) ;block scale

    (setq AttrTxt nil)

    (setq elist (entnext (dxf -1 elist)))
    (setq elist (entget elist))
    (/= "SEQEND" (dxf 0 elist))

    ; Find Attribute Text IF it exists
    (if (= "ATTRIB" (dxf 0 elist))
    (setq AttrTxt (cdr (assoc 1 elist))) ; set Attribute Text
    );if

    ; List Attribute Text
    (if (/= AttrTxt nil)
    (princ (strcat "\n" AttrTxt))
    );if

    ; valide file found...
    (if (= newAtt nil) (exit))

    ) ; screen_symb



    ; **** GET NEW SYMBOL MANUALLY ****
    ; *********************************
    (defun manual_symb ( / newSymPickA newSymPickB newSymPickC)
    ; newAtt is Symbol
    ; newSymPickA is 'repeat' variable

    (cond
    ((/= newAtt nil)
    (setq newSymPickA newAtt)
    (princ "\n ")
    (setq newSymPickA (strcase newSymPickA)) ; Set to UPPERCASE
    (princ (strcat "\nCurrent REPLACEMENT Symbol is ---> "newSymPickA" "))

    (setq newSymPickC
    (getstring "\nType in the 'Replacement' Block name or Press 'Return Key' to
    use above: "))
    (terpri)
    ; reset if space entered
    (if (= newSymPickC nil) (setq newAtt newSymPickA) (setq newAtt
    newSymPickC))
    (if (= newSymPickC "") (setq newAtt newSymPickA) (setq newAtt
    newSymPickC))
    )

    ((= newAtt nil)
    (setq newAtt (getstring "\nEnter REPLACEMENT Symbol name: "))
    (terpri)
    (if (= newAtt nil) (exit))
    )
    )
    newAtt

    ; **** Look for Existing Symbol File in DWG Data Base ****
    (setq BlkTst nil)
    (if (tblsearch "block" newAtt)
    (setq BlkTst "Y")(setq BlkTst "N")
    ) ;if

    ; **** Look for Existing Symbol File in Symbol Folder ****
    (setq refname (strcat newAtt ".dwg"))
    (setq fileok (findfile refname))
    (setq FileTst nil)
    (if
    (not fileok)
    (setq FileTst "N")(setq FileTst "Y")
    ) ;if

    ; Now Check for Valide Block Name (Data Base or Folder)
    (if
    (and (= BlkTst "N") (= FileTst "N"))
    ((setq end_msg "WARNING - Check your spelling")(exit))
    ) ;if

    ; valide file found...
    (if (= newAtt nil) (exit))

    ) ; manual_symb


    ; *** User Block Choice Selection ***
    (defun get-choice ( / a-1 a-2 w-1)
    (cond
    ((/= EntTyp nil)
    (setq a-1 (rtos EntTyp 5 0))
    (setq a-2 (strcat "\nEnter a Number 1 = Screen Selection 2 = Manual Entry
    <"a-1">: "))
    (princ "\n")
    (initget (+ 2 4))
    (setq w-1 (getreal a-2))
    (if (= nil w-1) (setq EntTyp EntTyp) (setq EntTyp w-1)))
    ((= EntTyp nil)
    (initget (+ 1 2 4))
    (setq EntTyp (getreal "\nEnter a Number 1 = Screen Selection 2 = Manual
    Entry: "))
    (princ "\n"))
    );cond
    EntTyp
    );defun



    ; *********************** *********************** ***********************
    ; *********************** **** PROGRAM START **** ***********************
    ; *********************** *********************** ***********************
    (defun C:XCHNG ( / end_msg cntr count AttrTxt ename elist newSymPick SymblPick
    )

    (setvar "cmdecho" 0)
    (setq curlyr (getvar "clayer")) ; get current layer

    ; Symbol size IF selected from Block Folder
    (setq figscl (getvar "UserR1")) ; find Figure Scale factor
    (setq figscI (getvar "UserI1")) ; find Figure Scale factor
    (setq Inmm (getvar "USerI1")) ; find if Inches 1 or MM 0
    (if (= Inmm 1) (setq figscal (/ figscl 25.4)))
    (if (= Inmm 0) (setq figscal figscl))

    ; set messages
    (setq end_msg "Total of entities replaced is: ")
    (setq cntr " - Symbol file NOT found!!!")


    ; User Block Choice Selection
    (get-choice)

    (cond ((= EntTyp 1) (screen_symb) (setq SymblPick "S"))
    ((= EntTyp 2) (manual_symb) (setq SymblPick "M"))
    ) ;cond


    ; *** Now Choose Existing Blocks ***
    (princ)
    (setq newAtt (strcase newAtt)) ; Set Symbol Name to UPPERCASE
    (princ (strcat "\nValide Symbol <"newAtt"> file found... Now Choose Blocks to
    Change: "))

    (setq existSymPick (ssget (list (cons 0 "insert"))))
    (setq count 0)

    (while existSymPick
    (setq enameA (ssname existSymPick count)
    elistA (entget enameA)
    count (+ 1 count)
    ) ;setq
    (setq cntr (rtos count 2 0))
    (setq Exinspt (dxf 10 elistA)) ;block insertion
    point
    (setq Exrotan (angtos (dxf 50 elistA))) ;block rotation angle
    (setq Exsymscl (dxf 41 elistA)) ;block scale WAS 43
    (setq Exlyrnam (dxf 8 elistA)) ;block layer
    (setq Exsymnam (dxf -1 elistA)) ;block name
    (command "layer" "s" Exlyrnam "") ;set working layer -
    temp
    (entdel Exsymnam) ;delete existing
    symbol

    ;;; Check First Symbol Selection Type with NO Attribute
    (if (and (= SymblPick "M")(= AttrTxt nil))
    (command "insert" newAtt Exinspt Exsymscl "" Exrotan) ;insert new symbol
    - MANUAL
    );if Manual with No Attribute
    (if (and (= SymblPick "S")(= AttrTxt nil))
    (command "insert" newAtt Exinspt newAttscl "" Exrotan) ;insert new symbol
    - SCREEN
    );if Screen with No Attribute

    ;;; Check First Symbol Selection Type with Attribute
    ; Set New Attribute to First Picked Attribute
    (setq AttrTxtNew AttrTxt)

    ; First make sure we have 'something' for Attribute Text
    (if (= AttrTxt "")
    (setq AttrTxtNew ".")
    (setq AttrTxtNew AttrTxt)
    );if

    ;;; CANNOT determine IF a new Manual Symbol has Attribute or not so IGNORE!
    (if (and (= SymblPick "S")(/= AttrTxt nil))
    (command "insert" newAtt Exinspt newAttscl "" Exrotan AttrTxtNew) ;SCREEN
    );if Screen with Attribute

    (princ)
    ) ;while


    ; *** END ***
    (setvar "clayer" curlyr) ;reset working layer
    (princ)(terpri)
    ) ;end Defun


    O/______________________________________ cut here _________________________
    0\
     
    Mr. B, Aug 15, 2007
    #2
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.