Batch block edit / redefine

[b.hunter]

I have got a series of large drawings (converted from ArchiCAD) with hundreds of blocks in each drawing and all the polylines within the blocks have different widths and colour by block.

I have been trying to develop some sort of batch to write all the blocks to a specific directory, then batch redefine the exported blocks, then reinsert (redefine) the blocks back into the original drawing. so far i have got as far as writing the blocks out to a directory, but don't really know the best way to go from here.

(DEFUN B2F()
(WHILE (SETQ BLKS (CDR (ASSOC 2 (TBLNEXT "BLOCK"))))
(COMMAND ".WBLOCK" (STRCAT "C:/NBLOCKS/" BLKS) BLKS)
)
(princ)
)
(B2F)

any thoughts or tips?
any alternate methods / suggestions?

many thanks.

Ben.

[kpblc2000]

What kind of redefinig you're trying to do? I think it's possible to redefine blocks by lisp without writing them to files.

[abdulhuck]

I have been trying to develop some sort of batch to write all the blocks to a specific directory, then batch redefine the exported blocks, then reinsert (redefine) the blocks back into the original drawing.Hi Ben,

I don't know your scope of redefining the blocks, but once you updated the blocks, you can insert and redefine with the following code.


.
(Defun ReinsertBlocks (/ blockName blocks nblkName)
(setq blocks (ssget "x" '((0 . "INSERT")))
blCount (sslength blocks)
num 0)
(repeat (sslength blocks)
(setq blockName (cdr (assoc 2 (entget (ssname blocks num)))))
(if (findfile (setq nblkName (strcat "c:\\projects\\nblocks\\" blockName ".dwg")))
(progn
(command "-insert" (strcat blockName "=" nblkName) "y")
(command)
(princ (strcat "\n" blockName " > redefined.\n"))
)
(princ (strcat "\nCould not find " nblkName))
)
(setq num (1+ num))
)
(princ)
)


Hope that helps.

Regards,

Abdul Huck

[b.hunter]

i want to set all polyline widths to zero and all colours to bylayer.

thanks.

[kpblc2000]

Does activex methods available?

[b.hunter]

i have had no experience with activex.could you give me a succinct overview?

[abdulhuck]

i want to set all polyline widths to zero and all colours to bylayer.

thanks.
Have a look at this thread

http://forums.augi.com/showthread.php?t=5547

Regards,

Abdul Huck

[kpblc2000]

I hope this code looks right:

(defun normlwpl (/ adoc)
;; loading activex extension. Requires at ACAD2002:
(vl-load-com)
;; getting activex-pointer to active document
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
;; start "undo" mark
(vla-startundomark adoc)
;; going through all block definitions
(vlax-for blkdef (vla-get-blocks adoc)
;; if block name is not like "Model_space" or "paper_space"
;; it means the block is not system used
(if (not (wcmatch (strcase (vla-get-name blkdef)) "*_SPACE*"))
;; going through all subentities of block
(vlax-for ent blkdef
;; entity name is AcDbPolyline - the entity is lightweightpolyline
(if (= (vla-get-objectname ent) "AcDbPolyline")
(progn
;; unerrored setting constant width to entity to zero
(vl-catch-all-apply '(lambda () (vla-put-constantwidth ent 0.)))
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of if
) ;_ end of vlax-for
(vla-endundomark adoc)
(princ)
) ;_ end of defun
Call sample:

Command: (normlwpl)

[b.hunter]

kpblc2000: thanks for your code! i dropped it into a lisp and ran it but nothing seemed to happen (no errors either). am i doing something wrong here?

abdulhuck:
thanks for the link. i found some code that does almost the exact thing i want, though i need it to be colour bylayer not byblock, and width zero not layer zero.
her is the code but i cant follow it to change the appropriate bits. can anyone help?


(defun C:FixBlock (/ ss cnt idx blkname donelist Grp Update)
(defun Grp (gc el) (cdr (assoc gc el)))
(defun Update (bname / ename elist)
(setq ename (tblobjname "BLOCK" bname))
(if
(and ename (zerop (logand 52 (Grp 70 (entget ename '("*"))))))
(progn
(while ename
(setq elist (entget ename '("*"))
elist (subst '(8 . "0") (assoc 8 elist) elist)
elist (if (assoc 62 elist)
(subst '(62 . 0) (assoc 62 elist) elist)
(append elist '((62 . 0)))))
(entmake elist)
(setq ename (entnext ename)))
(if (/= "ENDBLK" (Grp 0 elist))
(entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
'T))
)
(if (> (logand (Grp 70 (tblsearch "layer" "0")) 1) 0)
(princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
(progn
(if
(progn
(princ "\nPress <Enter> to fix all defined blocks\n")
(setq cnt 0
ss (ssget '((0 . "INSERT")))))
(progn
(setq idx (sslength ss))
(while (>= (setq idx (1- idx)) 0)
(if (not (member (setq blkname (Grp 2 (entget (ssname ss idx)))) donelist))
(progn
(if (Update blkname) (setq cnt (1+ cnt)))
(setq donelist (cons blkname donelist))))))
(while (setq blkname (Grp 2 (tblnext "BLOCK" (not blkname))))
(if (Update blkname) (setq cnt (1+ cnt)))))
(princ (strcat "\n" (itoa cnt) " block" (if (= cnt 1) "" "s") " redefined\n"))))
(princ)
)
;End-of-file



many thanks for your help.

[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]

[kpblc2000]

try to execute _regen command. Or change strings

(vla-endundomark adoc)
(princ)
) ;_ end of defunto

(vla-regen adoc acallviewports)
(vla-endundomark adoc)
(princ)
) ;_ end of defunDoes it works?

[b.hunter]

kpblc2000:
sorry! i jumped too soon.
it worked fine!

is there an easy way to set all the colours to bylayer in that code too?

many thanks.

[kpblc2000]

No, it's mine mistake (usually i do it at last step :))
Change colors to ByLayers or ByBlock? Should code change layer of entities?
For example (i erased unneede somments, ok?):

(defun normlwpl (/ adoc)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(vlax-for blkdef (vla-get-blocks adoc)
(if (not (wcmatch (strcase (vla-get-name blkdef)) "*_SPACE*"))
(vlax-for ent blkdef
;; entity name is AcDbPolyline - the entity is lightweightpolyline
(if (= (vla-get-objectname ent) "AcDbPolyline")
(progn
(vl-catch-all-apply '(lambda () (vla-put-constantwidth ent 0.)))
) ;_ end of progn
) ;_ end of if
;; These steps will be done to all sunetities:
;; Change color:
(vla-put-color ent 0) ; ByBlock
;; (vla-put-color ent 256) ; ByLayer

;; Change layer
;; (vla-put-layer ent "0") ; Change layer

;; Change lineweight
;; (vla-put-lineweight ent acLnWtByLayer) ; ByLayer
;; (vla-put-lineweight ent acLnWtByBlock) ; ByBlock
) ;_ end of vlax-for
) ;_ end of if
) ;_ end of vlax-for
(vla-regen adoc acallviewports)
(vla-endundomark adoc)
(princ)
) ;_ end of defun
Try to uncomment some strings and different results will be come ;)

[Terry Cadd]

Try this one. It should meet your specs of polyline widths set to 0, and colors set to bylayer.



(defun c:ReBlock (/ Block$ BlockList@ Cnt# EntLast^ EntList@ EntType$ SS& ZoomP@)
(setq ZoomP@ (list
(polar (getvar "VIEWCTR") (* pi 0.5)(/ (getvar "VIEWSIZE") 2.0))
(polar (getvar "VIEWCTR") (* pi 1.5)(/ (getvar "VIEWSIZE") 2.0)))
);setq
(command "UNDO" "BEGIN")
(command "ZOOM" "E")
(if (setq Block$ (cdr (assoc 2 (tblnext "BLOCK" t))))
(progn
(if (/= (substr Block$ 1 1) "*")
(setq BlockList@ (append BlockList@ (list Block$)))
);if
(while (setq Block$ (cdr (assoc 2 (tblnext "BLOCK"))))
(if (/= (substr Block$ 1 1) "*")
(setq BlockList@ (append BlockList@ (list Block$)))
);if
);while
(setq Cnt# 0)
(repeat (length BlockList@)
(setq Block$ (nth Cnt# BlockList@))
(setq EntLast^ (entlast))
(command "INSERT" (strcat "*" Block$) "0,0" 1 0)
(command "ZOOM" "E")
(setq SS& (ssadd))
(while (setq EntLast^ (entnext EntLast^))
(setq EntList@ (entget EntLast^)
EntType$ (cdr (assoc 0 EntList@))
);setq
(command "CHPROP" EntLast^ "" "C" "BYLAYER" "")
(if (= EntType$ "LWPOLYLINE")
(command "PEDIT" EntLast^ "W" 0 "")
);if
(ssadd EntLast^ SS&)
);while
(command "BLOCK" Block$ "Y" "0,0" SS& "")
(setq Cnt# (1+ Cnt#))
);repeat
);progn
);if
(command "ZOOM" (car ZoomP@)(cadr ZoomP@))
(command "UNDO" "END")
(princ)
);defun c:ReBlock

[b.hunter]

Thanks a lot guys!
you just saved me personally over about 5 hours a week!

Cheers!

[b.hunter]

I have been using the following code (below) to set the lineweight and layer of polylines within blocks for months with great success (thanks kpblc2000!!), but can anyone now help me to change attribute properties within the blocks at the same time (or in a separate step /code if need be?) in particular I am looking to set the text style to standard, colour to bylayer, and specify a new layer for the attributes – say layer “att-text”? many thanks.

Ben.





(defun normlwpl (/ adoc)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(vlax-for blkdef (vla-get-blocks adoc)
(if (not (wcmatch (strcase (vla-get-name blkdef)) "*_SPACE*"))
(vlax-for ent blkdef
;; entity name is AcDbPolyline - the entity is lightweightpolyline
(if (= (vla-get-objectname ent) "AcDbPolyline")
(progn
(vl-catch-all-apply '(lambda () (vla-put-constantwidth ent 0.)))
) ;_ end of progn
) ;_ end of if
;; These steps will be done to all sunetities:
;; Change color:
(vla-put-color ent 0) ; ByBlock
;; (vla-put-color ent 256) ; ByLayer

;; Change layer
;; (vla-put-layer ent "0") ; Change layer

;; Change lineweight
;; (vla-put-lineweight ent acLnWtByLayer) ; ByLayer
;; (vla-put-lineweight ent acLnWtByBlock) ; ByBlock
) ;_ end of vlax-for
) ;_ end of if
) ;_ end of vlax-for
(vla-regen adoc acallviewports)
(vla-endundomark adoc)
(princ)
) ;_ end of defun
Try to uncomment some strings and different results will be come ;)

[kpblc2000]

Something like this?

(defun c:normblk (/ adoc loc:norment)

(defun loc:norment (ent)
(foreach item (list
(cons "layer" "0") ; changing layer to "0"
(cons "color" 256) ; changing color to "ByLayer"
; To change color "ByBlock" comment prev string
; and uncomment next:
;(cons "color" 0)
(cons "lineweight" aclnwtbyblock) ; LW -> "ByBlock"
; To change lineweight "ByLayer" comment prev string
; and uncomment next:
;(cons "lineweight" aclnwtbylayer)
(cons "linetype" "byblock") ; LT -> "ByBlock"
) ;_ end of list
(if (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda () (vlax-put-property ent (car item) (cdr item)))
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
(princ (strcat "\nChanging block \""
(vla-get-name subent)
"\" subentiy "
(vla-get-objectname ent)
" "
(car item)
" ERROR# "
(itoa (getvar "errno"))
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
) ;_ end of foreach
) ;_ end of defun

(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(vlax-for blk_def (vla-get-blocks adoc)
(if (not (wcmatch (strcase (vla-get-name blk_def) t) "*_space*"))
(vlax-for subent blk_def
(cond
((wcmatch (strcase (vla-get-objectname subent) t) "*polyline")
(loc:norment subent)
)
((wcmatch (strcase (vla-get-objectname subent) t) "*attribute*")
(loc:norment subent)
)
) ;_ end of cond
) ;_ end of vlax-for
) ;_ end of if
) ;_ end of vlax-for
(vla-endundomark adoc)
(princ)
) ;_ end of defun
To call type at command prompt
normblk

[b.hunter]

Hi kpblc2000,

unless i am doing something wrong, it doesn't seek to work?

it runs (ie does something and doesn't give any errors) but the polylines and the attributes don’t change. Still the same layers / styles etc.

any tips?

[kpblc2000]

you have to regenerate a drawing. Or use this:
(defun c:normblk (/ adoc loc:norment)

(defun loc:norment (ent)
(foreach item (list
(cons "layer" "0") ; changing layer to "0"
(cons "color" 256) ; changing color to "ByLayer"
; To change color "ByBlock" comment prev string
; and uncomment next:
;(cons "color" 0)
(cons "lineweight" aclnwtbyblock) ; LW -> "ByBlock"
; To change lineweight "ByLayer" comment prev string
; and uncomment next:
;(cons "lineweight" aclnwtbylayer)
(cons "linetype" "byblock") ; LT -> "ByBlock"
) ;_ end of list
(if (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda () (vlax-put-property ent (car item) (cdr item)))
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
(princ (strcat "\nChanging block \""
(vla-get-name subent)
"\" subentiy "
(vla-get-objectname ent)
" "
(car item)
" ERROR# "
(itoa (getvar "errno"))
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
) ;_ end of foreach
) ;_ end of defun

(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(vlax-for blk_def (vla-get-blocks adoc)
(if (not (wcmatch (strcase (vla-get-name blk_def) t) "*_space*"))
(vlax-for subent blk_def
(cond
((wcmatch (strcase (vla-get-objectname subent) t) "*polyline")
(loc:norment subent)
)
((wcmatch (strcase (vla-get-objectname subent) t) "*attribute*")
(loc:norment subent)
)
) ;_ end of cond
) ;_ end of vlax-for
) ;_ end of if
) ;_ end of vlax-for
(vla-regen adoc acallviewports)
(vla-endundomark adoc)
(princ)
) ;_ end of defun

[b.hunter]

no, still the same outcome.

if i run the previous polyline only lisp it works fine but this one doesn't appear to do work.

would it make a difference that i have recently upgraded to AutoCAD 2008?

[kpblc2000]

Hmmmm... I wrote it and test at acad2005.
Right now i run it at AutoCAD 2008, it works. Could you attach (or send to me by e-mail) your dwg-file where the lisp not working?

[b.hunter]

yes, sure.

here is a small portion of one of my xrefs. i have set all objects to colour bylayer and all layers to colour 8. i have also set all text to style dpq_text. (which is what i would hope the attributes to be in the end).

the handrail (green type colour) hasn't changed to colour bylayer and the blocks with attributes haven't changed style.

thanks for the help.

[kpblc2000]

Ah, sorry. I always forget that attributes could have different settings with block reference.
You can run 2 versions of code:
To change attribute properties "Like a block" use this

(defun c:normblk1 (/ adoc loc:norment)

(defun loc:norment (ent)
(foreach item (list
(cons "layer" "0") ; changing layer to "0"
(cons "color" 256) ; changing color to "ByLayer"
; To change color "ByBlock" comment prev string
; and uncomment next:
;(cons "color" 0)
(cons "lineweight" aclnwtbyblock) ; LW -> "ByBlock"
; To change lineweight "ByLayer" comment prev string
; and uncomment next:
;(cons "lineweight" aclnwtbylayer)
(cons "linetype" "byblock") ; LT -> "ByBlock"
) ;_ end of list
(if (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda () (vlax-put-property ent (car item) (cdr item)))
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
(princ (strcat "\nChanging block \""
(vla-get-name subent)
"\" subentiy "
(vla-get-objectname ent)
" "
(car item)
" ERROR# "
(itoa (getvar "errno"))
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
) ;_ end of foreach
) ;_ end of defun

(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(vlax-for blk_def (vla-get-blocks adoc)
(cond
((not (wcmatch (strcase (vla-get-name blk_def) t) "*_space*"))
(vlax-for subent blk_def
(cond
((wcmatch (strcase (vla-get-objectname subent) t) "*polyline")
(loc:norment subent)
)
) ;_ end of cond
) ;_ end of vlax-for
)
(t
(vlax-for subent blk_def
(if (= (strcase (vla-get-objectname subent) t) "acdbblockreference")
(foreach attr
(vl-remove
nil
(append
(if
(> (vlax-safearray-get-u-bound
(vlax-variant-value (vla-getattributes subent))
1
) ;_ end of vlax-safearray-get-u-bound
0
) ;_ end of >
(vlax-safearray->list
(vlax-variant-value (vla-getattributes subent))
) ;_ end of vlax-safearray->list
) ;_ end of if
(if (> (vlax-safearray-get-u-bound
(vlax-variant-value
(vla-getconstantattributes subent)
) ;_ end of vlax-variant-value
1
) ;_ end of vlax-safearray-get-u-bound
0
) ;_ end of >
(vlax-safearray->list
(vlax-variant-value
(vla-getconstantattributes subent)
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of if
) ;_ end of append
) ;_ end of vl-remove
(foreach prop '("layer" "color" "linetype" "lineweight")
(vl-catch-all-apply
'(lambda ()
(vlax-put-property
attr
prop
(vlax-get-property subent prop)
) ;_ end of vlax-put-property
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of foreach
) ;_ end of foreach
) ;_ end of if
) ;_ end of vlax-for
)
) ;_ end of cond
) ;_ end of vlax-for
(vla-regen adoc acallviewports)
(vla-endundomark adoc)
(princ)
) ;_ end of defun
To change attribute properties to "ByBlock":

(defun c:normblk2 (/ adoc loc:norment)

(defun loc:norment (ent)
(foreach item (list
(cons "layer" "0") ; changing layer to "0"
(cons "color" 256) ; changing color to "ByLayer"
; To change color "ByBlock" comment prev string
; and uncomment next:
;(cons "color" 0)
(cons "lineweight" aclnwtbyblock) ; LW -> "ByBlock"
; To change lineweight "ByLayer" comment prev string
; and uncomment next:
;(cons "lineweight" aclnwtbylayer)
(cons "linetype" "byblock") ; LT -> "ByBlock"
) ;_ end of list
(if (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda () (vlax-put-property ent (car item) (cdr item)))
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
(princ (strcat "\nChanging block \""
(vla-get-name subent)
"\" subentiy "
(vla-get-objectname ent)
" "
(car item)
" ERROR# "
(itoa (getvar "errno"))
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
) ;_ end of foreach
) ;_ end of defun

(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(vlax-for blk_def (vla-get-blocks adoc)
(cond
((not (wcmatch (strcase (vla-get-name blk_def) t) "*_space*"))
(vlax-for subent blk_def
(cond
((wcmatch (strcase (vla-get-objectname subent) t) "*polyline")
(loc:norment subent)
)
) ;_ end of cond
) ;_ end of vlax-for
)
(t
(vlax-for subent blk_def
(if (= (strcase (vla-get-objectname subent) t) "acdbblockreference")
(foreach attr
(vl-remove
nil
(append
(if
(> (vlax-safearray-get-u-bound
(vlax-variant-value (vla-getattributes subent))
1
) ;_ end of vlax-safearray-get-u-bound
0
) ;_ end of >
(vlax-safearray->list
(vlax-variant-value (vla-getattributes subent))
) ;_ end of vlax-safearray->list
) ;_ end of if
(if (> (vlax-safearray-get-u-bound
(vlax-variant-value
(vla-getconstantattributes subent)
) ;_ end of vlax-variant-value
1
) ;_ end of vlax-safearray-get-u-bound
0
) ;_ end of >
(vlax-safearray->list
(vlax-variant-value
(vla-getconstantattributes subent)
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of if
) ;_ end of append
) ;_ end of vl-remove
(loc:norment attr)
) ;_ end of foreach
) ;_ end of if
) ;_ end of vlax-for
)
) ;_ end of cond
) ;_ end of vlax-for
(vla-regen adoc acallviewports)
(vla-endundomark adoc)
(princ)
) ;_ end of defun

[b.hunter]

maybe this is just me? it still doesn't seemed to have worked.

just to make sure I have asked the right question:

further to the original polyline issues (which you duly solved – thanks again) i have a series of blocks containing attributes where i am unable to freeze attribute separate from the rest of the block (linework) as they are on the same layer. ( problem part 1: change the layer of the attribute within the block to a specified attribute text layer)). For the instances’ where the attribute is to remane thawed / visible, I need the attribute to be colour bylayer (problem part 2: change the colour of the attribute within a block via a colour bylayer attribute on a specific layer) and to be able to change the style (problem part 3: change the text style of the attribute within a block to a specified style)


sorry if that was long winded...

does that change anything?

Thanks.

Ben.
P.s. i'm in Sydney and it's 5pm so i may not be able here to reply for much longer. thanks a lot for your help.

[kpblc2000]

Wait a minute, please. You want to change attributes (all) to some layer? Usually i'm using blocks with all subentities of them "ByBlock" - it seems more functionally. Try this (perhaps you're looking for this):

(defun test (/ _kpblc-error-catch adoc attr_lst)

(defun _kpblc-error-catch (protected-function
on-error-function
/
catch_error_result
)
;|*** Based on ruCAD|;
(setq catch_error_result (vl-catch-all-apply protected-function))
(if (and (vl-catch-all-error-p catch_error_result)
on-error-function
) ;_ end of and
(apply on-error-function
(list (vl-catch-all-error-message catch_error_result))
) ;_ end of apply
catch_error_result
) ;_ end of if
) ;_ end of defun

(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-StartUndoMark
(vlax-for blk-def (vla-get-blocks adoc)
(cond
((wcmatch (strcase (vla-get-name blk-def) t) "*_space*")
(vlax-for ent blk-def
(foreach prop (list '("color" . 256)
(cons "Lineweight" aclnwtbylayer)
'("linetype" . "bylayer")
) ;_ end of list
(_kpblc-error-catch
(function
(lambda () (vlax-put-property ent (car prop) (cdr prop)))
) ;_ end of function
'(lambda (x) (princ (strcat "\nEntity \"ByLayer\" ERROR : " x)))
) ;_ end of _kpblc-error-catch
) ;_ end of foreach
(if (and (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
(setq attr_lst
(vl-remove
'nil
(append
(if
(>= (vlax-safearray-get-u-bound
(vlax-variant-value
(vla-getattributes ent)
) ;_ end of vlax-variant-value
1
) ;_ end of vlax-safearray-get-u-bound
0
) ;_ end of >
(vlax-safearray->list
(vlax-variant-value (vla-getattributes ent))
) ;_ end of vlax-safearray->list
) ;_ end of if
(if (>= (vlax-safearray-get-u-bound
(vlax-variant-value
(vla-getconstantattributes ent)
) ;_ end of vlax-variant-value
1
) ;_ end of vlax-safearray-get-u-bound
0
) ;_ end of >
(vlax-safearray->list
(vlax-variant-value
(vla-getconstantattributes ent)
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of if
) ;_ end of append
) ;_ end of vl-remove
) ;_ end of setq
) ;_ end of and
(foreach attr attr_lst
(foreach prop (list '("layer" . "0")
'("color" . 0)
'("linetype" . "byblock")
(cons "Lineweight" aclnwtbyblock)
) ;_ end of list
(_kpblc-error-catch
(function
(lambda ()
(vlax-put-property attr (car prop) (cdr prop))
) ;_ end of lambda
) ;_ end of function
'(lambda (x)
(princ
(strcat
"\nAttribute \"ByBlock\" within block reference ERROR: "
x
) ;_ end of strcat
) ;_ end of princ
) ;_ end of lambda
) ;_ end of _kpblc-error-catch
) ;_ end of foreach
) ;_ end of foreach
) ;_ end of if
) ;_ end of vlax-for
)
(t
(vlax-for subent blk-def
(foreach prop (list '("layer" . "0")
'("color" . 0)
'("linetype" . "byblock")
(cons "Lineweight" aclnwtbyblock)
) ;_ end of list
(_kpblc-error-catch
(function
(lambda ()
(vlax-put-property subent (car prop) (cdr prop))
) ;_ end of lambda
) ;_ end of function
'(lambda (x)
(princ
(strcat
"\nEntity \"ByBlock\" within block definition ERROR: "
x
) ;_ end of strcat
) ;_ end of princ
) ;_ end of lambda
) ;_ end of _kpblc-error-catch
) ;_ end of foreach
) ;_ end of vlax-for
)
) ;_ end of cond
) ;_ end of vlax-for
(vla-endundomark adoc)
(princ)
) ;_ end of defun
In this case ALL entities changes settings to "ByLayer", and subentities in block references (and definitions) changes to "ByBlock". If it seems as you wish, it won't be a problem to add a entity filter (like "work only with linghtweight polylines and attributes). But i think you need namely this. Am i wrong?