社区 › Auto Lisp › Lisp从Selec创建选项卡

nlao 发表于 2022-7-6 07:06:36

Lisp从Selec创建选项卡

你好
 
我试图在实践中加快绘图速度，并引入了选项卡和发布的使用。是的，他们没有用。相反，他们将每个绘图页放在一个选项卡上，导致内存中断和崩溃。一些绘图在一个选项卡上超过30个。打印由选择窗口完成。
 
我想将这些文件更改为选项卡式，这样我就可以对它们使用“发布”和“打印并忘记”。
 
目前，我的方法是复制此多打印布局，并删除每个选项卡创建单个图纸时不需要的所有页面。漫长的过程，尤其是当它崩溃时。
 
我的问题是，是否有一个lisp例程，我可以在其中选择一个布局（选择窗口），并将该选择中的布局发送到一个新选项卡，然后从多页选项卡中删除。然后，我可以很快地完成这个多页选项卡，选择布局，lisp创建选项卡，将信息放在上面，然后进行下一个。不得来回切换、复制和粘贴等。
 
我对lisp还很陌生，有些对我来说毫无意义，但我已经达到了目的，所以请忍受我愚蠢的问题。
 
这是我到目前为止的代码，从论坛的其他地方刷来的。
 
 
;; lay = New Layout Name(Will be Created if non-existent)(defun CopytoLayout (lay / ss NewLay ObjLst)   (vl-load-com)   ; Lee Mac~27.01.10    (setq *acad* (cond (*acad*) ((vlax-get-acad-object)))         *adoc* (cond (*adoc*) ((vla-get-ActiveDocument *acad*))))    (cond ((not (snvalid lay)))          ((ssget)             (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *adoc*))            (setq ObjLst (cons Obj ObjLst)))                     (vla-delete ss)             (if (vl-catch-all-error-p                  (setq NewLay (vl-catch-all-apply                                 (function vla-item)                                 (list (vla-get-Layouts *adoc*) lay))))                            (setq NewLay (vla-Add (vla-get-Layouts *adoc*) lay)))             (vla-CopyObjects *adoc*                            (vlax-make-variant                (vlax-safearray-fill                  (vlax-make-safearray vlax-vbObject                  (cons 0 (1- (length ObjLst))))                                    (reverse ObjLst)))                            (vla-get-Block NewLay)))))

Lee Mac 发表于 2022-7-6 07:20:41

这将使用标题栏的边界框为每个图纸创建新布局。

Lee Mac 发表于 2022-7-6 07:41:40

或者，这是我链接到的代码的缩短版本-这是使用选择的代码：
 

(defun c:LayoutCutter ( / _UniqueKey acdoc aclay aclyo acpvp j nwlay objs sel )
;; © Lee Mac 2011

(defun _UniqueKey ( collection seed / i key ) (setq i 0)
   (while
   (not
       (vl-catch-all-error-p
         (vl-catch-all-apply 'vla-item
         (list collection (setq key (strcat seed (itoa (setq i (1+ i))))))
         )
       )
   )
   )
   key
)

(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       aclyo (vla-get-layouts acdoc)
       aclay (vla-get-activelayout acdoc)
       acpvp (vla-item (vla-get-block aclay) 0)
)
(if (setq sel (ssget "_:L" (list (cons 410 (getvar 'CTAB)))))
   (progn
   (setq nwlay (vla-add aclyo (_UniqueKey aclyo "Layout")))
   (if (not (eq "MODEL" (strcase (vla-get-name aclay))))
       (vla-copyfrom aclay nwlay)
   )
   (repeat (setq j (sslength sel))
       (setq objs (cons (vlax-ename->vla-object (ssname sel (setq j (1- j)))) objs))
   )
   (vla-copyobjects acdoc
       (vlax-make-variant
         (vlax-safearray-fill
         (vlax-make-safearray vlax-vbobject (cons 0 (length objs))) (cons acpvp (reverse objs))
         )
       )
       (vla-get-block nwlay)
   )
   (mapcar 'vla-delete objs)
   )
)
(princ)
)
(vl-load-com) (princ)

nlao 发表于 2022-7-6 07:48:15

 
哦，是的！非常感谢你。这将节省我很多时间。

Lee Mac 发表于 2022-7-6 08:06:20

 
非常欢迎。我可能会考虑把这个程序添加到我的网站上，因为它看起来很有用

maxi2570 发表于 2022-7-6 08:15:39

你好
 
我尝试将此代码用于AutoCAD 2012。我为电子模式编写多页文档，能够自动生成用于打印pdf的布局将节省大量时间。
 
使用自动版本（应该循环的版本）我得到了一个自动错误，使用短版本我没有得到我应该得到的结果，但生成的布局比选定的标题栏大得多。
 
你有没有用CAD 2012测试过它？
 
谢谢
 

查看完整版本: Lisp从Selec创建选项卡