move blocks to other layer by attribute value

[pmxcad]

Hello,

Is there a lisp that can place blocks on other layers by attribute value?

I have several drawings with blocks placed on wrong layer(s). These blocks have all an attribute LAYER. I can import values from Excel (Autocad electrical). So they can get a new layer name in that attribute.

 

 

Thanks,

 

pmxcad

[Tharwat]

Do you mean that the attribute value is the layer name itself ? And what's if are there more than one Attribute value , which value should be considered ?

 

And what's if the layer name not existed in the drawing ? should it be made ? (what about the color , lineweight and line type) .

 

Regards.

[Tharwat]

This is according to what I think it might be as your needs . if not , just clarify your goal with the routine please .

 

(defun c:TesT (/ col ss i sset att value e)
 ;; Tharwat 05. Nov. 2011 ;;
 (if
   (setq col 1
         ss  (ssget "_x" '((0 . "INSERT") (66 . 1)))
   )
    (repeat (setq i (sslength ss))
      (setq sset (ssname ss (setq i (1- i))))
      (setq
        att
         (vlax-invoke (vlax-ename->vla-object sset) "Getattributes")
      )
      (foreach x att
        (setq value (vla-get-textstring x))
        (if (not (tblsearch "LAYER" value))
          (entmakex (list '(0 . "LAYER")
                          '(100 . "AcDbSymbolTableRecord")
                          '(100 . "AcDbLayerTableRecord")
                          (cons 2 Value)
                          (cons 70 0)
                          (cons 62 col)
                    )
          )
        )
        (setq col (1+ col))
      )
      (entmod
        (subst (cons 8 value) (assoc 8 (setq e (entget sset))) e)
      )
    )
    (princ)
 )
 (princ)
)

 

Tharwat

[pBe]

I would think that there's a specific TAG to search (say tag name "LAYER") for and use the string value of that attribute as layer name. otherwise if the block has mulitple attribtues say 3, it will use the last attributes value as layer name tharwat

 

(defun c:TesT (/ aDoc lyrs TagToSearch ss atb lynm)
 (vl-load-com)
 (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
lyrs (vla-get-layers aDoc)
 )
 (setq TagToSearch "LAYER")  ;<---- tag to search ??? 
 (if (ssget ":L" '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for itm (setq ss (vla-get-ActiveSelectionSet
         aDoc
       )
     )
(if (setq atb (assoc TagToSearch
       (mapcar '(lambda (j)
    (list (vla-get-tagstring j)
          (vla-get-textstring j)
          
    )
         )
        (vlax-invoke itm 'GetAttributes)
       )
       )
    )
  (vla-put-layer
    itm
    (if (vl-catch-all-error-p
   (vl-catch-all-apply
     'vla-item
     (list lyrs
    (setq lynm
    (cadr
      atb
    )
    )
     )
   )
 )
      (progn (vla-add lyrs lynm) lynm)
      lynm
    )
  )
)
     )
     (vla-delete ss)
   )
 )
 (princ)
)

Edited November 5, 2011 by pBe

[pmxcad]

Superrrrrrr........pBe, Tharwat.

Works great.

 

Thanks,

 

PmxCAD

[Tharwat]

You're welcome .

 

I am really glad that it did work as needed for you .

 

Tharwat