社区 › Auto Lisp › 有没有制作lisp代码的想法？

hosyn 发表于 2022-7-5 18:36:26

有没有制作lisp代码的想法？

基本原则是：

select block
explode block
select exploded block (entlast)
copy to layer "122"
and
make new block of copied entity in "122" layer

Tharwat 发表于 2022-7-5 18:40:52

无需分解并重新选择最后一个实体来创建新块，也可能具有相同的名称。
 
您需要将选定块中的实体移动到该层名称“122”，仅此而已。

hosyn 发表于 2022-7-5 18:45:51

我正在寻找copytolayer命令，以便复制块不同的层，但我找不到。
只需对块以外的任何对象执行copy2layer操作

Tharwat 发表于 2022-7-5 18:50:46

你在说什么样的障碍？属性块还是普通块？
 
您可以上传保存到cad 2009的示例图形吗？

hosyn 发表于 2022-7-5 18:52:33

普通块（和内部块）
例如，我制作了一个简单的块，我想在一个命令lisp中将其复制到两个特定的层LAYER1和LAYER2中
塔尔瓦特。图纸

hosyn 发表于 2022-7-5 18:58:24

普通块（和内部块）
例如，我制作了一个简单的块，我想在一个命令lisp中将其复制到两个特定的层LAYER1和LAYER2中
塔尔瓦特。图纸

Tharwat 发表于 2022-7-5 19:01:17

试试这个。
 

(defun c:Test (/ l ss doc )
;;----------------------------;;
;; Tharwat 20.09.2015                ;;
;; Move object in Normal         ;;
;; Blocks to a specific Layer        ;;
;;----------------------------;;
(if (and (/= "" (setq l (getstring t "\nSpecify the Layer name to move objects in blocks to :")))
      (if (not (tblsearch "LAYER" l))
          (progn
            (alert (strcat "Layer name < " l " > is not found !!")) nil)
          t
          )
      (princ "\nSelect Normal blocks to proceed :")
      (setq ss (ssget "_:L" '((0 . "INSERT"))))
      )
(progn
   (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
   ((lambda ( r / sn nm lst obj)
      (while (setq sn (ssname ss (setq r (1+ r))))
      (if (not (member (setq nm (cdr (assoc 2 (entget sn)))) lst))
          (progn
            (setq lst (cons nm lst)
                  obj (tblobjname "BLOCK" nm)
                  )
            (while (setq obj (entnext obj))
            (entmod (subst (cons 8 l) (assoc 8 (entget obj)) (entget obj)))
            )
            )
          )
      )
      )
   -1
   )
   (vla-endundomark doc)
   (vla-regen doc acAllViewports)
   )
)
(princ)
)(vl-load-com)

hosyn 发表于 2022-7-5 19:05:10

尊敬的Tharwat：
我试过了，非常适合移动物体实体
我想要这个子程序来复制到一些层，而不是移动：？

Tharwat 发表于 2022-7-5 19:09:14

 
好的
 
 
你这是什么意思？

hosyn 发表于 2022-7-5 19:11:10

我想用另一个名字复制某些层中的块。
例如，主块是“dfd”，我想在第1、2、3层的同一坐标处用自由的新名称重复复制这个块
 


(defun c:Test (/ l ss doc )
;;----------------------------;;
;; Tharwat 20.09.2015                ;;
;; Move object in Normal         ;;<< i wanna copy (not move)
;; Blocks to a specific Layer        ;;
;;----------------------------;;
(if (and (/= "" (setq l (getstring t "\nSpecify the Layer name to move objects in blocks to :")))
      (if (not (tblsearch "LAYER" l))
          (progn
            (alert (strcat "Layer name < " l " > is not found !!")) nil)
          t

查看完整版本: 有没有制作lisp代码的想法？