Jump to content
JAX

CHANGE OBJECT LINETYPE INCLUDE NESTED BLOCKS

Recommended Posts

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

Share this post


Link to post
Share on other sites
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 ?

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
JAX
Posted (edited)

Selection should be just click and drag and all selected objects could be changed to a specific line type. Here I attached another lisp for change color of selected objects. It is working perfectly for color change by allowing me select specific color and changing nested blocks also. I need same method for change line type. 

COLORA.LSP

Edited by JAX

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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
 

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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

 

  • Thanks 1

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...