changing of block entity layers

[sudarsann]

Hi,

A block having few entities with different layers. I have to change those entity layers from one layer to another layer without exploding the block using LISP.
Ex: "1" layer entities have to change to "a" layer.
"2" layer entities have to change to "b" layer.
"3" layer entities have to change to "c" layer.

Can any one help for the above.

Regards

Sudarsan

[3wood]

You can try attached CHZ20.VLX (need a free registration)

Settings as below:

You need prepare a Layer name matching file first. Below is an example file. Just change layer names to your need and save it as a txt file.

Select this file when CHZ20 pops up a file selecting dialogue box.

; Use semicolon before notes
; One line for one matching rule
; The rule format is like below:
; MATCHING LIST  *NEW_LAYER
; Use asterisk (star) "*" before new layer
; Matching list is a list which can contain more than one condition
; For matching index color, use dot pair (62 . COLOR)
; For matching linetype, use dot pair (6 . LINETYPE)
; For matching layer, use dot pair (8 . "layername")
; Leave a space on both sides of the dot symbol.
; Bracket must be coupled.
; Following are example rule lines, you can modify them and make your own rules.
; ByLayer color is represented by (62 . 256), ByBlock color is (62 . 0)

;((62 . 1)) 		*CENTERLINE	;Change red color objects to Layer Centerline
;((62 . 2)) 		*Outline		;Change yellow color objects to Layer Outline
;((62 . 3)) 		*Layer3		;Change green color objects to Layer3
;((62 . 0)(6 . "hidden")) 	*hidden		;Change objects with hidden linetype AND in ByBlock color to Layer Hidden
;((6 . "Bylayer")(0 . "arc"))	*arc		;Change arc objects with ByLayer linetype to Layer Arc.
;((8 . "defpoints"))		*Defpoints	;Remain objects on layer defpoints
;("True")			*0		;Change all other objects except above to Layer 0
((8 . "1"))		*a		;Chang objects on Layer 1 to Layer a
((8 . "2"))		*b		;Chang objects on Layer 1 to Layer a
((8 . "3"))		*c		;Chang objects on Layer 1 to Layer a

[hmsilva]

Was untested,

rereding de code, didin't make sense..

Henrique

[Kent1Cooper]

If you don't otherwise still need Layers 1, 2 and 3 remaining in the drawing for any objects outside the Block, you can just use LAYMRG, which will put even objects inside Block definitions on the Layers that their original Layers are to be merged into.

[hmsilva · Accepted solution]

Untested, but makes more sense (I hope)

(vl-load-com)
(defun c:demo (/ put-layer)

  (defun put-layer (obj old-lay new-lay / layers olay)
    (or *adoc (setq *adoc (vla-get-activedocument (vlax-get-acad-object))))
    (setq layers (vla-get-layers *adoc))
    (if (vl-catch-all-error-p
          (vl-catch-all-apply 'vla-item (list layers new-lay))
        )
      (progn
        (vla-add layers new-lay)
        (setq layers (vla-get-layers *adoc))
      )
    )
    (if (= (vla-get-Lock (setq olay (vla-item layers old-lay))) :vlax-true)
      (progn
        (vla-put-Lock olay :vlax-false)
        (vla-put-Layer obj new-lay)
        (vla-put-Lock olay :vlax-true)
      )
      (vla-put-Layer obj new-lay)
    )
  )

  (or *adoc (setq *adoc (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for blk (vla-get-blocks *adoc)
    (if (and (= (vla-get-IsXref blk) :vlax-false)
             (= (vla-get-IsLayout blk) :vlax-false)
        )
      (vlax-for x blk
        (cond ((= (vla-get-Layer x) "1")
               (put-layer x "1" "a")
              )
              ((= (vla-get-Layer x) "2")
               (put-layer x "2" "b")
              )
              ((= (vla-get-Layer x) "3")
               (put-layer x "3" "c")
              )
        )
      )
    )
  )
  (vla-regen *adoc acAllViewports)
  (princ)
)

Henrique

[Lee_Mac · Accepted solution]

Here is a draft of a Vanilla AutoLISP version:

(defun c:layermap ( / a d e l m x )
    (setq m
       '(
            ("1" . "a")
            ("2" . "b")
            ("3" . "c")
        )
    )
    (while (setq d (tblnext "block" (null d)))
        (setq e (tblobjname "block" (cdr (assoc 2 d))))
        (while (setq e (entnext e))
            (setq x (entget e)
                  l (assoc 8 x)
            )
            (if (setq a (cdr (assoc (cdr l) m)))
                (entmod (subst (cons 8 a) l x))
            )
        )
    )
    (command "_.regen")
    (princ)
)

[sudarsann]

Dear Mr.Lee,

Your reply is very useful to me, but one more help required from you.
The requirement is: By selecting the block, all entities of all layers in block have to change into another layer by entering in command prompt.
It is very helpful to me.

find the attachement of dwg file for example.

Regards
Sudarsan

[stevor]

A resurectee:

  (defun DXF_ (n L) (cdr (assoc n L)) )
 
 ; input yes no
 (defun I_YN (qstr ynflg / tf nf it ig k) ;
  (princ (strcat qstr (if ynflg " N or < Y > " " Y or < N > ")))
  (while (and (setq it (car (setq ig (grread T)))) (/= 6 it )
              (setq ik (cadr ig)) ; key maybe
              (not (and (= 2 it) (or    ; key board
                (setq nf (or (= 110 ik) (= 78 ik) ) )
                (setq tf (or (= 121 ik) (= 89 ik) ) )
                (= 13 ik)   (= 32 ik) ) )  )
               (not (= it 11)) ) ) ; end while  ; mou R
   (setq ynflg (cond (nf nil) (tf t) (t ynflg) ) )
   (princ (if ynflg " Y " " N "))  ynflg )
   
   
 (setq *CSECF (I_yn " Change Subentity Colors to 0/256" *CSECF))
 (PRINC"\n Note Xref exclusion ") ;
 ;  Block subentities to Layer a b c ; 0
 (defun c:BE3  (/ ES EDL BNS BDL BEN SEN )
  (princ "\n Subentity Color change is: ")
  (princ (if *CSECF " Enabled " "disabled "))
  (if (and (setq ES (entseL "\n SeL Blk to change Subents :"))
           (setq EDL (entget (car ES)))
           (or (= (DXF_ 0 EDL ) "INSERT")
               (and (princ "\n Not a Insert-Block") nil))
           (setq BNS (DXF_ 2 EDL))  ; block name str
           (OR (not (assoc 1 EDL)) ; Xref exclude,  optional
               (and (princ "\n Is a Xref") nil))
       )
    (progn  ;  bLock tabLe
     (setq BDL (tbLsearch "BLOCK" BNS) )  ; table data list
     (setq BEN (tbLobjname "bLock" (dxf_ 2 BDL))  SEN BEN)  
     (whiLe (setq SEN (entnext SEN) )  ; or SEN for ?
      (setq SDL (entget SEN)  SLYN (DXF_ 8 SDL) )
      (PRINC " SLYN : ")(PRIN1 SLYN)
      ;(IF (/= SLYN "0") (setq SDL (subst '(8 . "0") (assoc 8 SDL) SDL)))
      (cond
       ((= SLYN "1") (setq SDL (subst '(8 . "a") (assoc 8 SDL) SDL)))
       ((= SLYN "2") (setq SDL (subst '(8 . "b") (assoc 8 SDL) SDL)))
       ((= SLYN "3") (setq SDL (subst '(8 . "c") (assoc 8 SDL) SDL)))
      )
     (IF (and *CSECF (setq ECN (DXF_ 62 SDL)) (/= 256 ECN)) ; COLOR TO 0
        (setq SDL (subst '(62 . 256) (assoc 62 SDL) SDL) ))
     (entmod SDL) ; anyway    
     )
    ) (princ " NYET ") ) (princ) ) ; D