CHANGE OBJECT LINETYPE INCLUDE NESTED BLOCKS

[JAX]

I found a lisp (attached) to change object line type. But this lisp is not changing nested blocks line types and forcing one by one selection . I need to change linetype of all objects include nested blocks and as area selection.  Please help

ChangeObjLinetype.lsp

[BIGAL]

Google "change linetype nested blocks" it does exist easier than changing your code. 

 

Question are you talking about 1 block by name so all blocks of that name will update ?

[JAX]

If a drawing have many blocks and  3 to 4 level nested blocks for each blocks, How can I make all the selected items lines into Phantom or Hidden lines in easy way? I am expecting a lisp that ask me for select the required objects include blocks which I want to change line type and ask for select line type from the popup list. Is that possible?

[dlanorh]

4 hours ago, JAX said:

If a drawing have many blocks and  3 to 4 level nested blocks for each blocks, How can I make all the selected items lines into Phantom or Hidden lines in easy way? I am expecting a lisp that ask me for select the required objects include blocks which I want to change line type and ask for select line type from the popup list. Is that possible?

 

How are you going to select an item in a block nested 3 or 4 levels deep? Do you just want to change (substitute) one linetype for another globally, just in blocks or something else?

[JAX]

Selection should be just click and drag and all selected objects could be changed to a specific line type. 

 

Edited December 15, 2020 by JAX

[BIGAL]

The quick answer is this (vla-put-Color Obj Color) its in a defun in the code the equivalent for a linetype is (vla-put-Linetype Obj ltype) so copy the Change-Object-Color defun to Change-Object-ltype and have a go at editing the defun delete all the stuff about text strings look at 1st 6 lines. You need to change the other code where the  Change-Object-Color is called also.

 

You need to change this also as it opens up the color pick dcl  (if (and (setq color (acad_colordlg 256)) to  (if (and (setq ltype (getstring "\nEnter linetype")) I wont go into now but you can pop the linetypes list in a dcl so pick or you can hard code just 1 line type or a few to pick from.

 

A good task to start learning as the majority of code is there. We are here to help and support people more if they have a go.

[JAX]

Thank you for your support. I don't have any knowledge about codes. I tried to change the code as per your instructions. But still I am not reaching to the result. 
Could you please post as a working lisp. Please

[JAX]

On 10/5/2020 at 2:56 AM, BIGAL said:

The quick answer is this (vla-put-Color Obj Color) its in a defun in the code the equivalent for a linetype is (vla-put-Linetype Obj ltype) so copy the Change-Object-Color defun to Change-Object-ltype and have a go at editing the defun delete all the stuff about text strings look at 1st 6 lines. You need to change the other code where the  Change-Object-Color is called also.

 

You need to change this also as it opens up the color pick dcl  (if (and (setq color (acad_colordlg 256)) to  (if (and (setq ltype (getstring "\nEnter linetype")) I wont go into now but you can pop the linetypes list in a dcl so pick or you can hard code just 1 line type or a few to pick from.

 

A good task to start learning as the majority of code is there. We are here to help and support people more if they have a go.

I changed the code like this. But not working. Please check


 

(defun c:chltyp (/ adoc blocks ltyp ins lays ss lst *error*)
;;; ltyp Area - - Changes in the ltyp of selected items in the area
(defun *error* (msg)(bg:layer-status-restore)(princ msg)(princ))
 (setq adoc   (vla-get-activedocument (vlax-get-acad-object))
       blocks (vla-get-blocks adoc)
       lays   (vla-get-layers adoc)
 ) ;_ end of setq
 (if (and (setq ltype (getstring "\nEnter linetype"))
          (setq ss (ssget))
          (progn
            (repeat (setq ins (sslength ss)) ;_ end setq
              (setq lst (cons (ssname ss (setq ins (1- ins))) lst))
            ) ;_ end repeat
            lst
          ) ;_ end of progn
     ) ;_ end of and
   (progn
     (vla-startundomark adoc)
     (bg:layer-status-save)
     (foreach ins lst
       (setq ins (vlax-ename->vla-object ins))
       (if (= (vla-get-objectname ins) "AcDbBlockReference")
         (if (vlax-property-available-p ins 'path)
           (princ "\nThis is external reference! Skip.")
           (progn
             (_pl:block-ltype blocks ins ltyp lays)
             (Change-Object-ltype ins ltype)
           )
         ) ;_ end of if
         (Change-Object-ltype ins ltype)
       ) ;_ end of if
       
     ) ;_ end of repeat
     (vla-regen adoc acallviewports)
     (bg:layer-status-restore)
     (vla-endundomark adoc)
   ) ;_ end of progn
 ) ;_ end of if
 (princ)
) ;_ end of defun

(defun _pl:block-ltype (blocks ins ltyp lays / lay layfrz layloc)
 (vlax-for e (vla-item blocks (vla-get-name ins))
   (setq lay (vla-item lays (vla-get-layer e)))
   (if (= (vla-get-freeze lay) :vlax-true)
     (progn (setq layfrz (cons lay layfrz))
            (vla-put-freeze lay :vlax-false)
     ) ;_ end of progn
   ) ;_ end of if
   (if (= (vla-get-lock lay) :vlax-true)
     (progn (setq layloc (cons lay layloc))
            (vla-put-lock lay :vlax-false)
     ) ;_ end of progn
   ) ;_ end of if
   (vl-catch-all-apply (function vla-put-ltype) (list e ltype))
   (if (and (= (vla-get-objectname e) "AcDbBlockReference")
            (not (vlax-property-available-p e 'path))
       ) ;_ end of and
     (_pl:block-ltype blocks e ltyp lays)
   ) ;_ end of if
   (foreach i layfrz (vla-put-freeze i :vlax-true))
   (foreach i layloc (vla-put-lock i :vlax-true))
 ) ;_ end of vlax-for
) ;_ end of defun
(defun Change-Object-ltype (Obj ltyp  / txtstr tmp txt)
;;;========================================================================

) ;_ end of defun
(defun bg:layer-status-restore ()
   (foreach item *BG_LAYER_LST*
     (if (not (vlax-erased-p (car item)))
       (vl-catch-all-apply
         '(lambda ()
            (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
            (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
            ) ;_ end of lambda
         ) ;_ end of vl-catch-all-apply
       ) ;_ end of if
     ) ;_ end of foreach
   (setq *BG_LAYER_LST* nil)
   ) ;_ end of defun

 (defun bg:layer-status-save ()
   (setq *BG_LAYER_LST* nil)
   (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
     (setq *BG_LAYER_LST* (cons (list item
                                 (cons "freeze" (vla-get-freeze item))
                                 (cons "lock" (vla-get-lock item))
                                 ) ;_ end of cons
                           *BG_LAYER_LST*
                           ) ;_ end of cons
           ) ;_ end of setq
     (vla-put-lock item :vlax-false)
     (if (= (vla-get-freeze item) :vlax-true)
     (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
     ) ;_ end of vlax-for
   ) ;_ end of defun
(progn
 (princ
   "\chltyp - Changes in the ltyp of selected items in the area"
 ) ;_ end of princ
 (princ)
) ;_ end of progn
 

[BIGAL]

Re your PM I googled a bit more and found something you need to post a dwg for testing.

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/changing-colour-of-nested-block/td-p/6579582

[JAX]

21 hours ago, BIGAL said:

Re your PM I googled a bit more and found something you need to post a dwg for testing.

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/changing-colour-of-nested-block/td-p/6579582

Sample attached. Please try to change the all red Rectangles to any same line type. Imagine that you are getting many blocks like this and you need to select them and change line type. I don't want to touch colors.

sample.dwg

[BIGAL]

Try this credit to Kent Cooper for original code.

 

;;  BlockSParts0Bylayer.lsp
;;  = change all Parts of definitions of Selected Block(s) [other
;;    than on Layer Defpoints] to Layer 0 with Color ByLayer
;;  Kent Cooper, 3 November 2014

;; Modified by Alan h OCT 2020
;; now does linetype only

(vl-load-com)
(defun C:blocklt (/ nametolist blkss inc blk blknames ent edata obj)

(setq ltype (getstring "please enter linetype name"))
(if (tblsearch "Ltype" ltype)
(princ "Found")
(progn
(alert "Linetype not found please load linetype\n \nTry again")
(exit)
)
)
  (defun nametolist (blk / blkobj blkname); get Block name and put it into list of names
    (if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref
      (progn
        (setq
          blkobj (vlax-ename->vla-object blk)
          blkname
            (vlax-get-property blkobj
              (if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name)
                ; to work with older versions that don't have dynamic Blocks
            ); ...get-property & blkname
        ); setq
        (if
          (not (member blkname blknames)); name not already in list
          (setq blknames (append blknames (list blkname))); then -- add to end of list
        ); if
      ); progn
    ); if
  ); defun -- nametolist
  (setq blkss (ssget '((0 . "INSERT")))); User selection of any number of Blocks/Minserts/Xrefs
  (repeat (setq inc (sslength blkss)); get names from initial selection
    (setq blk (ssname blkss (setq inc (1- inc))))
    (nametolist blk)
  ); repeat
  (while (setq blk (car blknames)); as long as there's another Block name in list
    ;; [done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to the list]
    (setq ent (tblobjname "block" blk)); Block definition as entity
    (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
      (setq edata (entget ent))
      (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
      (if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
        (progn
          (setq obj (vlax-ename->vla-object ent))
	(if (vlax-property-available-p obj 'Linetype)
         	 (vla-put-linetype obj Ltype)
	)
          ;(vla-put-color obj 256); color ByLayer
        ); progn
      ); if
    ); while -- sub-entities
    (setq blknames (cdr blknames)); take first one off
  ); while
  (command "_.regen")
  (princ)
); defun

 

[JAX]

3 hours ago, BIGAL said:

Try this credit to Kent Cooper for original code.

 

;;  BlockSParts0Bylayer.lsp
;;  = change all Parts of definitions of Selected Block(s) [other
;;    than on Layer Defpoints] to Layer 0 with Color ByLayer
;;  Kent Cooper, 3 November 2014

;; Modified by Alan h OCT 2020
;; now does linetype only

(vl-load-com)
(defun C:blocklt (/ nametolist blkss inc blk blknames ent edata obj)

(setq ltype (getstring "please enter linetype name"))
(if (tblsearch "Ltype" ltype)
(princ "Found")
(progn
(alert "Linetype not found please load linetype\n \nTry again")
(exit)
)
)
  (defun nametolist (blk / blkobj blkname); get Block name and put it into list of names
    (if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref
      (progn
        (setq
          blkobj (vlax-ename->vla-object blk)
          blkname
            (vlax-get-property blkobj
              (if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name)
                ; to work with older versions that don't have dynamic Blocks
            ); ...get-property & blkname
        ); setq
        (if
          (not (member blkname blknames)); name not already in list
          (setq blknames (append blknames (list blkname))); then -- add to end of list
        ); if
      ); progn
    ); if
  ); defun -- nametolist
  (setq blkss (ssget '((0 . "INSERT")))); User selection of any number of Blocks/Minserts/Xrefs
  (repeat (setq inc (sslength blkss)); get names from initial selection
    (setq blk (ssname blkss (setq inc (1- inc))))
    (nametolist blk)
  ); repeat
  (while (setq blk (car blknames)); as long as there's another Block name in list
    ;; [done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to the list]
    (setq ent (tblobjname "block" blk)); Block definition as entity
    (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
      (setq edata (entget ent))
      (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
      (if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
        (progn
          (setq obj (vlax-ename->vla-object ent))
	(if (vlax-property-available-p obj 'Linetype)
         	 (vla-put-linetype obj Ltype)
	)
          ;(vla-put-color obj 256); color ByLayer
        ); progn
      ); if
    ); while -- sub-entities
    (setq blknames (cdr blknames)); take first one off
  ); while
  (command "_.regen")
  (princ)
); defun

 

This code is working fine. Thank you very much