将所有块设置为ByLaye

baker · 发表于 2022-7-6 09:04:35

我搜索了一下，并没有真正找到我想要的结果。

我正在寻找一个Lisp，当调用它时，它会将DWG中的每个块更改为ByLayer颜色和线型。

我最近发现了一个有效的，但你必须选择每个区块。

这是我找到的Lisp程序。。

    ;   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 FB () (d_FixBlock))
(fb)
(princ)

此外，如果每次需要时都不进行加载，我无法使这个lisp正常工作。

BlackBox · 发表于 2022-7-6 09:10:24

为什么不直接使用SETBYLAYER命令？

baker · 发表于 2022-7-6 09:11:42

因为我忘了那个命令。。英雄联盟

BlackBox · 发表于 2022-7-6 09:18:27

lmfao公司

... 很乐意帮忙！：眨眼：

Tharwat · 发表于 2022-7-6 09:20:46

我也是，每次伦德曼用他珍贵的话语提醒我，我总是忘记。

我的例行程序已经准备好交付，但这个命令持有我的能量LOL。。。。

David Bethel · 发表于 2022-7-6 09:23:30

老实说，我对setbyblock了解不多，但这也应该提供一些灵活性

copy


[b][color=BLACK]([/color][/b]defun c:blk2def [b][color=FUCHSIA]([/color][/b]/ bl tdef fe fd[b][color=FUCHSIA])[/color][/b]
[color=#8b4513];;;GROUP LIST Group_Number Sysvar_Name New_Value[/color]
 [b][color=FUCHSIA]([/color][/b]setq bl '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b] 8 [color=#2f4f4f]"CLAYER"[/color]      [color=#2f4f4f]"0"[/color][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b] 6 [color=#2f4f4f]"CELTYPE"[/color]     [color=#2f4f4f]"BYLAYER"[/color][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]39 [color=#2f4f4f]"THICKNESS"[/color]    0.0[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]48 [color=#2f4f4f]"CELTSCALE"[/color]    1[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]62 [color=#2f4f4f]"CECOLOR"[/color]      256[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq tdef [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"BLOCK"[/color] [b][color=GREEN]([/color][/b]not tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq fe [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc -2 tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]princ [b][color=MAROON]([/color][/b]strcat [color=#2f4f4f]"\n"[/color] [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 2 tdef[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entmake tdef[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]while fe
          [b][color=MAROON]([/color][/b]setq fd [b][color=GREEN]([/color][/b]entget fe[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
          [b][color=MAROON]([/color][/b]foreach g bl
             [b][color=GREEN]([/color][/b]cond [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]not [b][color=PURPLE]([/color][/b]getvar [b][color=TEAL]([/color][/b]nth 1 g[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                   [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]assoc [b][color=PURPLE]([/color][/b]nth 0 g[b][color=PURPLE])[/color][/b] fd[b][color=RED])[/color][/b]
                    [b][color=RED]([/color][/b]setq fd [b][color=PURPLE]([/color][/b]subst [b][color=TEAL]([/color][/b]cons [b][color=OLIVE]([/color][/b]nth 0 g[b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]nth 2 g[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b]
                                    [b][color=TEAL]([/color][/b]assoc [b][color=OLIVE]([/color][/b]nth 0 g[b][color=OLIVE])[/color][/b] fd[b][color=TEAL])[/color][/b] fd[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                   [b][color=BLUE]([/color][/b]T
                    [b][color=RED]([/color][/b]setq fd [b][color=PURPLE]([/color][/b]append fd [b][color=TEAL]([/color][/b]list [b][color=OLIVE]([/color][/b]cons [b][color=GRAY]([/color][/b]nth 0 g[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]nth 2 g[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
          [b][color=MAROON]([/color][/b]entmake fd[b][color=MAROON])[/color][/b]
          [b][color=MAROON]([/color][/b]setq fe [b][color=GREEN]([/color][/b]entnext fe[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]"_.REGENALL"[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

您可以根据需要操作列表bl。
[列表]

SN有效层名称

线型必须在调用之前存在，才能正常工作。

颜色0-256
[/列表]

它不处理现有属性。

-大卫

baker · 发表于 2022-7-6 09:29:11

啊。。。现在我想起来了。。我希望块中的线条移动到第0层，以及其他所有内容的“bylayer”。。

Lee Mac · 发表于 2022-7-6 09:32:11

尝试一下：

copy

(defun c:test ( / acdoc )
   ;;-----------------------------------------------------------
   ;; All block objects to Layer "0", Color/Linetype ByLayer
   ;; Lee Mac 2011  -  www.lee-mac.com
   ;;-----------------------------------------------------------
 
   (vlax-for block
       (vla-get-blocks
           (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
       )
       (if
           (and
               (eq :vlax-false (vla-get-islayout block))
               (eq :vlax-false (vla-get-isxref block))
           )
           (vlax-for object block
               (mapcar
                   (function
                       (lambda ( property value )
                           (vl-catch-all-apply 'vlax-put-property (list object property value))
                       )
                   )
                  '(layer color linetype)
                   (list "0" acbylayer "BYLAYER")
               )
           )
       )
   )
   (vla-regen acdoc acallviewports)
   (princ)
)
(vl-load-com) (princ)

baker · 发表于 2022-7-6 09:33:26

李，

你会杀了我的。这很好，我将使用lisp。。有没有办法使用另一个lisp（或此lisp中的选项）将块的对象放置到插入块的层？

BlackBox · 发表于 2022-7-6 09:39:29

考虑替换此行：

copy


(list [color=red]"0"[/color] acbylayer "BYLAYER")

... 有了这个：

copy


(list [color=red](vla-get-layer object)[/color] acbylayer "BYLAYER")

[编程交流] 将所有块设置为ByLaye

发表回复

精选推荐