multiselection of blocks to place the line on block properties

[jim78b]

ciao chiedo a voi che siete esperti, io ho questo lisp che mette l'oggetto selezionato (blocco) su by block. tranne che vorrei quando chiede di selezionare l'elemento di selezione tramite finestra più elementi e non solo 1.


; file name: fixblock.lsp
; description: puts all of a blocks sub-entities on layer 0 with color and
; linetype set to byblock. the block, itself, will remain on
; its' original layer.
;
; revision:
; 3-dec-2003 yz
; changed program to work from a keyword on the command line
;*******************************************************************************
(defun d_fixblock (/ eblocksel ; block selection
linsertdata ; entity data
sblockname ; block name
lblockdata ; entity data
esubentity ; sub-entity name
lsubdata ; sub-entity data
icount ; counter
)

;; redefine error handler

(setq
d_#error *error*
*error* d_fb_error
) ;_ end setq

;; set up environment

(setq #sysvars (#savesysvars (list "cmdecho")))

(setvar "cmdecho" 0)
(command "._undo" "_group")

;; get block from user and make sure it's an insert type

(if (setq eblocksel (entsel "\nselect block to change :"))
(progn
(if (setq linsertdata (entget (car eblocksel)))
(if (= (cdr (assoc 0 linsertdata)) "insert")
(setq sblockname (cdr (assoc 2 linsertdata)))
(progn
(alert "entity selected is not a block!")
(exit)
) ;_ end progn
) ;_ end if
(progn
(alert "invalid block selection!")
(exit)
) ;_ end progn
) ;_ end if

;; get block info from the block table

(setq
lblockdata (tblsearch "block" sblockname)
esubentity (cdr (assoc -2 lblockdata))
) ;_ end setq

;; make sure block is not an xref

(if (not (assoc 1 lblockdata))
(progn
(princ "\nprocessing block: ")
(princ sblockname)

(princ "\nupdating blocks sub-entities. . .")

;; parse through all of the blocks sub-entities

(while esubentity

(princ " .")
(setq lsubdata (entget esubentity))

;; update layer property

(if (assoc 8 lsubdata)
(progn
(setq lsubdata
(subst
(cons 8 "0")
(assoc 8 lsubdata)
lsubdata
) ;_ end subst
) ;_ end setq
(entmod lsubdata)
) ;_ end progn
) ;_ end if

;; update the linetype property

(if (assoc 6 lsubdata)
(progn
(setq lsubdata
(subst
(cons 6 "byblock")
(assoc 6 lsubdata)
lsubdata
) ;_ end subst
) ;_ end setq
(entmod lsubdata)
) ;_ end progn
(entmod (append lsubdata (list (cons 6 "byblock"))))
) ;_ end if

;; update the color property

(if (assoc 62 lsubdata)
(progn
(setq lsubdata
(subst
(cons 62 0)
(assoc 62 lsubdata)
lsubdata
) ;_ end subst
) ;_ end setq
(entmod lsubdata)
) ;_ end progn
(entmod (append lsubdata (list (cons 62 0))))
) ;_ end if

(setq esubentity (entnext esubentity))
; get next sub entity

) ; end while

;; update attributes

(idc_fb_updattribs)

) ; end progn
(alert "xref selected. not updated!")
) ; end if
) ; end progn
(alert "nothing selected.")
) ; end if

;;; pop error stack and reset environment

(idc_restoresysvars)

(princ "\ndone!")

(setq *error* d_#error)

(princ)

) ; end defun

;*******************************************************************************
; function to update block attributes
;*******************************************************************************
(defun idc_fb_updattribs ()

;; update any attribute definitions

(setq icount 0)

(princ "\nupdating attributes. . .")
(if (setq ssinserts (ssget "x"
(list (cons 0 "insert")
(cons 66 1)
(cons 2 sblockname)
) ;_ end list
) ;_ end ssget
) ;_ end setq
(repeat (sslength ssinserts)

(setq eblockname (ssname ssinserts icount))

(if (setq esubentity (entnext eblockname))
(setq
lsubdata (entget esubentity)
esubtype (cdr (assoc 0 lsubdata))
) ;_ end setq
) ;_ end if

(while (or (= esubtype "attrib") (= esubtype "seqend"))

;; update layer property

(if (assoc 8 lsubdata)
(progn
(setq lsubdata
(subst
(cons 8 "0")
(assoc 8 lsubdata)
lsubdata
) ;_ end subst
) ;_ end setq
(entmod lsubdata)
) ;_ end progn
) ;_ end if

;; update the linetype property

(if (assoc 6 lsubdata)
(progn
(setq lsubdata
(subst
(cons 6 "byblock")
(assoc 6 lsubdata)
lsubdata
) ;_ end subst
) ;_ end setq
(entmod lsubdata)
) ;_ end progn
(entmod (append lsubdata (list (cons 6 "byblock"))))
) ;_ end if

;; update the color property

(if (assoc 62 lsubdata)
(progn
(setq lsubdata
(subst
(cons 62 0)
(assoc 62 lsubdata)
lsubdata
) ;_ end subst
) ;_ end setq
(entmod lsubdata)
) ;_ end progn
(entmod (append lsubdata (list (cons 62 0))))
) ;_ end if

(if (setq esubentity (entnext esubentity))
(setq
lsubdata (entget esubentity)
esubtype (cdr (assoc 0 lsubdata))
) ;_ end setq
(setq esubtype nil)
) ;_ end if

) ; end while

(setq icount (1+ icount))

) ; end repeat

) ; end if
(command "regen")
) ; end defun

;*******************************************************************************
; function to save a list of system variables
;*******************************************************************************
(defun #savesysvars (lvarlist / ssystemvar)
(mapcar
'(lambda (ssystemvar)
(setq lsystemvars
(append lsystemvars
(list (list ssystemvar (getvar ssystemvar)))
) ;_ end append
) ;_ end setq
) ;_ end lambda
lvarlist
) ;_ end mapcar

lsystemvars

) ;_ end defun
;*******************************************************************************
; function to restore a list of system variables
;*******************************************************************************
(defun idc_restoresysvars ()
(mapcar
'(lambda (ssystemvar)
(setvar (car ssystemvar) (cadr ssystemvar))
) ;_ end lambda
#sysvars
) ;_ end mapcar
) ;_ end defun
;*******************************************************************************
; error handler
;*******************************************************************************
(defun d_fb_error (msg)

(princ "\nerror occurred in the fix block routine...")
(princ "\nerror: ")
(princ msg)

(setq *error* d_#error)
(if *error*
(*error* msg)
) ;_ end if

(command)

(if (/= msg "quit / exit abort")
(progn
(command "._undo" "_end")
(command "._u")
) ;_ end progn
) ;_ end if

(idc_restoresysvars)

(princ)

) ;_ end defun
;*******************************************************************************

(defun c:fixblock () (d_fixblock))
(princ)

 

[confutatis]

use that which seems more synthetic to me. .

(defun c:fixblock2 ()
 (setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
       grublo (ssget '((0 . "insert")))
       ssgetblocks '()
       ssgetblocks1 '()
 )

 (repeat (setq index(sslength grublo))
  (setq ssgetblocks (cons (vla-get-effectivename (vlax-ename->vla-object (ssname grublo (setq index(1- index))))) ssgetblocks))
 )

 (foreach elem ssgetblocks
  (if (not(member elem ssgetblocks1))
   (setq ssgetblocks1 (cons elem ssgetblocks1))
  )
 ) 
  
 (foreach elem ssgetblocks1
  (setq bloccovl(vla-item blocks elem)
	index 0
  )	

  (repeat (vla-get-count bloccovl)
   (vla-put-color (vla-item bloccovl index) 0)
   (vla-put-linetype (vla-item bloccovl index) "byblock")
   (setq index (1+ index))
  )

 )

 (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acallviewports)

)

 

[jim78b]

grazie grande !domani provo .

 

[jim78b]

hi I tried your lisp, only thing does not change in byblock nested blocks

use that which seems more synthetic to me. .

(defun c:fixblock2 ()
 (setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
       grublo (ssget '((0 . "insert")))
       ssgetblocks '()
       ssgetblocks1 '()
 )

 (repeat (setq index(sslength grublo))
  (setq ssgetblocks (cons (vla-get-effectivename (vlax-ename->vla-object (ssname grublo (setq index(1- index))))) ssgetblocks))
 )

 (foreach elem ssgetblocks
  (if (not(member elem ssgetblocks1))
   (setq ssgetblocks1 (cons elem ssgetblocks1))
  )
 ) 
  
 (foreach elem ssgetblocks1
  (setq bloccovl(vla-item blocks elem)
	index 0
  )	

  (repeat (vla-get-count bloccovl)
   (vla-put-color (vla-item bloccovl index) 0)
   (vla-put-linetype (vla-item bloccovl index) "byblock")
   (setq index (1+ index))
  )

 )

 (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acallviewports)

)