Author Topic: force data in all blocks to bylayer  (Read 1335 times)

0 Members and 1 Guest are viewing this topic.

curmudgeon

  • Newt
  • Posts: 192
force data in all blocks to bylayer
« on: April 02, 2009, 01:17:09 PM »
I hope I was concise in the topic - I am in a hurry.

I have a friend with a problem. he has a very large file with many blocks that he needs to use as a background.
we discussed options, but he wants to redefine all the blocks in the drawing such that the entities within have colour bylayer.

OK

I think it will look like a tablesearch of blocks and processing each entity. in order to get each entity "bylayer" .
I believe the correct method is to just not set the colour dxf code at all. default is bylayer.

I am going to try to solve this for it's academic merit, but to get it done in time to do my friend any good, this go around, I would love any help I can get. perhaps there is one sitting on the shelf somewhere around here.


thanks,

roy

Code: [Select]
(entget (cdr (assoc -2 (tblnext "block"))))
« Last Edit: April 02, 2009, 01:22:55 PM by curmudgeon »
Never express yourself more clearly than you are able to think.

ronjonp

  • Needs a day job
  • Posts: 7022

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

curmudgeon

  • Newt
  • Posts: 192
Re: force data in all blocks to bylayer
« Reply #2 on: April 02, 2009, 01:43:11 PM »
thanks, but I get
; error: no function definition: VLAX-GET-ACAD-OBJECT

I assume I need to load some vlax, but I have never done that before.

so far on my end, I setq it to an entity with a forced colour (62 . 4) and
Code: [Select]
(setq it (subst (cdr (member (assoc 62 it) it)) (member (assoc 62 it) it) it))
(entmod it)
(entupd (cdr (assoc -1 it)))

I will look up vlax in the help files to see if I can get things running.
Never express yourself more clearly than you are able to think.

MP

  • Seagull
  • Posts: 17399
Re: force data in all blocks to bylayer
« Reply #3 on: April 02, 2009, 01:44:20 PM »
thanks, but I get
; error: no function definition: VLAX-GET-ACAD-OBJECT

execute this before invoking any activex based lisp:

(vl-load-com)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

gile

  • Water Moccasin
  • Posts: 2224
  • Marseille, France
Re: force data in all blocks to bylayer
« Reply #4 on: April 02, 2009, 01:58:38 PM »
You can have a look to Edit_Bloc routine wich can do this and some more.
Speaking English as a French Frog

Matt__W

  • Seagull
  • Posts: 12951
  • I like my water diluted.
Re: force data in all blocks to bylayer
« Reply #5 on: April 02, 2009, 02:00:01 PM »
...he wants to redefine all the blocks in the drawing such that the entities within have colour bylayer.

One word: SETBYLAYER
Autodesk Expert Elite
Autodesk Revit Architecture, Structure, MEP Mechanical and MEP Electrical Certified Professional
Building Performance Analysis Certified (BPAC v3.0)
Autodesk Navisworks 2014 Essentials

Andrea

  • Water Moccasin
  • Posts: 2360
Re: force data in all blocks to bylayer
« Reply #6 on: April 02, 2009, 02:22:33 PM »
I have an old one....but don't know the author name.

It work since autoCAD 12 to 2009 (2010 not tested)

Code: [Select]
    ;   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.

    ;*******************************************************************************
(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:FB () (d_FixBlock))

Keep smile...

highflyingbird

  • Bull Frog
  • Posts: 414
  • Later equals never.
Re: force data in all blocks to bylayer
« Reply #7 on: April 02, 2009, 02:23:04 PM »
This is a complete routine. I wish it is helpful for you.
Code: [Select]
(vl-load-com)

;;; 运行命令test                              
;;; Run command: test                        
(defun c:test (/ LayLst)
  (setq *APP (vlax-get-acad-object))
  (setq *DOC (vla-get-ActiveDocument *APP))
  (setq *BLK (vla-get-blocks *DOC))
  (setq LayLst (Get_Layer_Status *DOC))
  (Unlock_All_Layers *DOC)
  (Thaw_All_Layers *DOC)
  (change-entities-in-blocks *BLK)
  (Restore_Layer_Status LayLst)
  (princ)
)

;;; 主要函数                                  
;;; Main function                            
(defun change-entities-in-blocks (*BLK / name blks)
  (vlax-for blk *BLK
    (vlax-for Obj blk
      (vla-put-Color Obj 256)          ;256  byLayer
      (if (or
   (= (vla-get-objectname obj) "AcDbBlockReference")
   (= (vla-get-objectname obj) "AcDbMInsertBlock")
          )
(foreach Att (vlax-invoke Obj 'GetAttributes)
 (vla-put-Color Att 256)      ;256  byLayer
)
      )
    )
  )
)

;;; 以下函数仅仅为防止出错用                  
;;; These functions below to avoid some errors
;;; ==========================================
;;; 得到图层状态                              
;;; Get the status of All layers              
(defun Get_Layer_Status (*DOC / laylst)
  (setq laylst (vla-get-layers *DOC))
  (mapcar
    (function
      (lambda (x / lst)
(vlax-for n laylst
 (setq lst (cons (cons n (vlax-get-property n x)) lst))
)
      )
    )
    (list "LayerOn" "Lock" "Freeze")
  )
)

;;; 恢复图层状态                              
;;; Restore the status of All layers          
(defun Restore_Layer_status (LayLst /)
  (mapcar
    (function
      (lambda (x y)
(foreach n X
 (if (or (/= (vla-get-name (car n)) (getvar "CLAYER"))
 (/= y "Freeze")
     ) ;对于当前层排除冻结操作,以防出错
   (vlax-put-property (car n) y (cdr n))
 )
)
      )
    )
    LayLst
    (list "LayerOn" "Lock" "Freeze")
  )
)

;;; 解锁所有图层                              
;;; Unlock all layers                        
(defun Unlock_All_Layers (*DOC)
  (vlax-for n (vla-get-layers *DOC)
    (vla-put-lock n :vlax-false)
  )
)

;;; 解冻所有图层                              
;;; Thaw all layers                          
(defun Thaw_All_Layers (*DOC)
  (vlax-for n (vla-get-layers *DOC)
    (if (/= (vla-get-name n) (getvar "CLAYER"))
      (vla-put-Freeze n :vlax-false)
    )
  )
)
I am a bilingualist,Chinese and Chinglish.

curmudgeon

  • Newt
  • Posts: 192
Re: force data in all blocks to bylayer
« Reply #8 on: April 02, 2009, 02:28:50 PM »
MP - I wandered through the help files, saw (vl-load-com) and guessed that it would serve. I pasted it into the vlax I got here and she ran. So, I sent THAT to my friend. thanks. this was the first time I had used that particular command.

gile - thanks for the link to your code. plainly, I have not had enough time to appreciate it fully. I will take that time. when I get out of this chair, this afternoon I am chauffeuring my two youngest to French class(es). as I look through your code, I will see if we can read your comments in their original form.
 :-)

Matt - your one word means nothing to me. perhaps the fact that I am running Autocad 2000 like it came out of the box has a lot to do with that. Autocad 2009, I have a copy I have access to at the "branch office", but I have not needed it yet. so I remain ignorant of any particulars. of Revit, I got another friend to take one of his files and export to gbXML so that I could use it to reverse engineer and to write lisp to write to gbXML. specifically, a destination program is HAP. Revit uses undocumented tags, or I do not have the most current schema.

thanks again guys.

and as I hit the POST button, I see I have two more replies. THANK YOU ALL, AND I WILL REVIEW EVERY HELPFUL COMMENT AS SOON AS I RETURN.

EOF
Never express yourself more clearly than you are able to think.

GDF

  • Water Moccasin
  • Posts: 1990
Re: force data in all blocks to bylayer
« Reply #9 on: April 02, 2009, 02:58:50 PM »
You can have a look to Edit_Bloc routine wich can do this and some more.

Gile

A great tool, thanks for sharing it.

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2019x64 Windows 10x64