社区 › Auto Lisp › 块元素和块到“

srinak47 发表于 2022-7-5 23:39:32

块元素和块到“

嗨，任何人都可以编辑这个Lisp程序。。
 
此Lisp将我的块元素（块内的元素）转换为所需的层，但块（主块）层保持不变。。。
 
我想更改块元素、嵌套块元素和要在“0”或“所需层”中更改的块
 
我只是不知道如何改变块层。。。
 
 


(defun c:norm (/ *error* adoc lst_layer func_restore-layers)

(defun *error* (msg)
   (func_restore-layers)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun

(defun func_restore-layers ()
   (foreach item lst_layer
   (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
   (vl-catch-all-apply
       '(lambda ()
          (vla-put-freeze
            (car item)
            (cdr (assoc "freeze" (cdr item)))
            ) ;_ end of vla-put-freeze
          ) ;_ end of lambda
       ) ;_ end of vl-catch-all-apply
   ) ;_ end of foreach
   ) ;_ end of defun

(vl-load-com)
(vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-startundomark
(if (and (not (vl-catch-all-error-p
               (setq selset
                        (vl-catch-all-apply
                        (function
                            (lambda ()
                              (ssget '((0 . "INSERT")))
                              ) ;_ end of lambda
                            ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of vl-catch-all-error-p
               ) ;_ end of not
          selset
          ) ;_ end of and
   (progn
   (vlax-for item (vla-get-layers adoc)
       (setq
         lst_layer (cons (list item
                               (cons "lock" (vla-get-lock item))
                               (cons "freeze" (vla-get-freeze item))
                               ) ;_ end of list
                         lst_layer
                         ) ;_ end of cons
         ) ;_ end of setq
       (vla-put-lock item :vlax-false)
       (vl-catch-all-apply
         '(lambda () (vla-put-freeze item :vlax-false))
         ) ;_ end of vl-catch-all-apply
       ) ;_ end of vlax-for
   (foreach blk_def
            (mapcar
                (function
                  (lambda (x)
                  (vla-item (vla-get-blocks adoc) x)
                  ) ;_ end of lambda
                  ) ;_ end of function
                ((lambda (/ res)
                   (foreach item (mapcar
                                 (function
                                     (lambda (x)
                                       (vla-get-name
                                       (vlax-ename->vla-object x)
                                       ) ;_ end of vla-get-name
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                 ((lambda (/ tab item)
                                    (repeat (setq tabnil
                                                    item (sslength selset)
                                                    ) ;_ end setq
                                        (setq
                                          tab
                                           (cons
                                             (ssname selset
                                                   (setq item (1- item))
                                                   ) ;_ end of ssname
                                             tab
                                             ) ;_ end of cons
                                          ) ;_ end of setq
                                        ) ;_ end of repeat
                                    tab
                                    ) ;_ end of lambda
                                    )
                                 ) ;_ end of mapcar
                     (if (not (member item res))
                     (setq res (cons item res))
                     ) ;_ end of if
                     ) ;_ end of foreach
                   (reverse res)
                   ) ;_ end of lambda
               )
                ) ;_ end of mapcar
       (vlax-for ent blk_def
         (vla-put-layer ent "0")
         (vla-put-color ent 0)
         (vla-put-lineweight ent aclnwtbyblock)
         (vla-put-linetype ent "byblock")
         ) ;_ end of vlax-for
       ) ;_ end of foreach
   (func_restore-layers)
   (vla-regen adoc acallviewports)
   ) ;_ end of progn
   ) ;_ end of if
(vla-endundomark adoc)
(princ)
) ;_ end of defun

Tharwat 发表于 2022-7-5 23:51:18

是否将图形中所有块中的所有对象更改为一个特定图层名？

srinak47 发表于 2022-7-5 23:51:49

如。。我必须选择所有家具对象和家具块（甚至嵌套块）到特定的层名称。。。
 
同样的事情，我必须做的机械和管道等。。。

ymg3 发表于 2022-7-5 23:59:46

你有没有试过Gille Chanteau的这个套路：
 
编辑_块
 
ymg公司

marko_ribar 发表于 2022-7-6 00:05:05

嗨，ymg。。。我检查了Gile的代码，确实发现了一些不足。。。在所有参照上选择缩放选项后，块在当前图形块集合中不会更新，因此我必须在例程的末尾添加两行：
 
除此之外，我已经成功地将DCL实现到LSP例程中，因此您不需要它，它都在lisp中-您可以轻松地将此例程添加到启动套件中，这就是我所做的。。。套路写得很好，所有这些都是对Gilles Chanteaux的赞扬。。。
 
M、 R。
（我会附上我的版本，供那些想下载和使用的人使用）
编辑块。lsp

ymg3 发表于 2022-7-6 00:14:28

谢谢Marko，
 
吉尔一直是一个伟大的！贡献者
 
ymg公司

marko_ribar 发表于 2022-7-6 00:20:42

是的，这一切都可以，但如果你检查例行程序，它不会回应OP的请求。。。
 
OP，寻找标记的高亮线，并更改为所需的值，以满足您的需要。。。
 

(defun c:norm ( / *error* adoc lst_layer func_restore-layers tab )

(defun *error* (msg)
   (func_restore-layers)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun

(defun func_restore-layers ()
   (foreach item lst_layer
   (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
   (vl-catch-all-apply
       '(lambda ()
          (vla-put-freeze
            (car item)
            (cdr (assoc "freeze" (cdr item)))
            ) ;_ end of vla-put-freeze
          ) ;_ end of lambda
       ) ;_ end of vl-catch-all-apply
   ) ;_ end of foreach
   ) ;_ end of defun

(vl-load-com)
(vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-startundomark
(if (and (not (vl-catch-all-error-p
               (setq selset
                        (vl-catch-all-apply
                        (function
                            (lambda ()
                              (ssget '((0 . "INSERT")))
                              ) ;_ end of lambda
                            ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of vl-catch-all-error-p
               ) ;_ end of not
          selset
          ) ;_ end of and
   (progn
   (vlax-for item (vla-get-layers adoc)
       (setq
         lst_layer (cons (list item
                               (cons "lock" (vla-get-lock item))
                               (cons "freeze" (vla-get-freeze item))
                               ) ;_ end of list
                         lst_layer
                         ) ;_ end of cons
         ) ;_ end of setq
       (vla-put-lock item :vlax-false)
       (vl-catch-all-apply
         '(lambda () (vla-put-freeze item :vlax-false))
         ) ;_ end of vl-catch-all-apply
       ) ;_ end of vlax-for
   (foreach blk_def
            (mapcar
                (function
                  (lambda (x)
                  (vla-item (vla-get-blocks adoc) x)
                  ) ;_ end of lambda
                  ) ;_ end of function
                ((lambda (/ res)
                   (foreach item (mapcar
                                 (function
                                     (lambda (x)
                                       (vla-get-name
                                       (vlax-ename->vla-object x)
                                       ) ;_ end of vla-get-name
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                 ((lambda (/ item)
                                    (repeat (setq tabnil
                                                    item (sslength selset)
                                                    ) ;_ end setq
                                        (setq
                                          tab
                                           (cons
                                             (ssname selset
                                                   (setq item (1- item))
                                                   ) ;_ end of ssname
                                             tab
                                             ) ;_ end of cons
                                          ) ;_ end of setq
                                        ) ;_ end of repeat
                                    tab
                                    ) ;_ end of lambda
                                    )
                                 ) ;_ end of mapcar
                     (if (not (member item res))
                     (setq res (cons item res))
                     ) ;_ end of if
                     ) ;_ end of foreach
                   (reverse res)
                   ) ;_ end of lambda
               )
                ) ;_ end of mapcar
       (vlax-for ent blk_def
         (vla-put-layer ent "0")
         (vla-put-color ent 0)
         (vla-put-lineweight ent aclnwtbyblock)
         (vla-put-linetype ent "byblock")
         ) ;_ end of vlax-for
       ) ;_ end of foreach
   (func_restore-layers)
   (vla-regen adoc acallviewports)
   ) ;_ end of progn
   ) ;_ end of if
(vla-endundomark adoc)
(foreach bl tab
   (vla-put-layer (vlax-ename->vla-object bl) "0") ;;; => Change "0" to desired Layer name ;;;
)
(princ)
) ;_ end of defun

 
M、 R。

flyfox1047 发表于 2022-7-6 00:22:27

 
我真的同意

srinak47 发表于 2022-7-6 00:28:42

嗯，我想改变块和嵌套块内所有对象的层，以及块也进入同一层。。。
 
 
我还没有测试！！！将在12小时后进行测试。。。。

srinak47 发表于 2022-7-6 00:39:26

嘿m8谢谢。。。这就是我想要修改的。。。谢谢但是这个lisp没有考虑嵌套块。。。我希望嵌套lisp更改为“0”层或所需层。。。。。
 
是的，你真的很厉害。。。。你得到了我真正想要的，但没有做到。。。这真是太棒了。。。请将要更改的行添加到嵌套块。。。。
 
对不起，我的英语（我不是用这种语言写的）
 

查看完整版本: 块元素和块到“