从一个层移动对象

ABuckingham · 发表于 2022-7-6 14:26:35

我被分配了一个相当大的单调的工作，希望有人能帮我。我需要使用一些可预测的条件将对象从一个层移动到另一个层，我不想花几天的时间来做这件事，这里是瘦的。

给定一个对象，检查它所在的层是否以-E结尾，例如FOO-BAR-E

在一个名为TEMP的单独模板文件中。DWG，检查是否存在后缀为-N的图层，如果存在，则移动从模板导入图层并将对象移动到该图层，因此如果FOO-BAR-N是模板中的图层，则将该图层带入当前图形，然后将对象从FOO-BAR-E移动到FOO-BAR-E

如果没有后缀为-N的层，请检查同一模板文件中是否有无后缀层，如果有，请将其移动到该层，使FOO-BAR-E到FOO-BAR

如果这两个都不存在，那么只需移动到下一个对象。冲洗并重复接下来的200张图纸。

我对VBA或AutoLISP不挑剔，我在AutoCad 2008中工作。

任何帮助都会很好。

Lee Mac · 发表于 2022-7-6 14:35:03

一切似乎都可以做到-但我认为最好在运行LISP之前将图层更改输入到LISP中，而不是使用模板文件-在LISP中的图形之间切换已经很难了。。。

ABuckingham · 发表于 2022-7-6 14:41:29

谢谢李，今天下午当我回到那个项目时，我会查出来的。

Lee Mac · 发表于 2022-7-6 14:46:30

上述方法行不通-我将删除它，看看还能想出什么其他方法

ABuckingham · 发表于 2022-7-6 14:49:41

谢谢李，我试了一下，正如你所说，它不起作用。如果我不是在为Microstation（）学习VBA，我会在这个周末努力拼凑一些东西，但这个项目没有我的其他项目那么紧迫。

一如既往，感谢您对社区的帮助和贡献。

Lee Mac · 发表于 2022-7-6 14:56:40

试试这个，伙计：

（我正在学习这个ObjectDBX的东西，所以有点碰运气……）

copy


;; ObjectDBX Tester  by Lee McDonnell (Lee Mac)
;; Credit to Tony Tanzillo for Directory Browser, Tim Willey
(defun c:MacDwg (/ refLst *error* *acad Shell fDir Dir dbx lay Tag)
 (vl-load-com)
 (setq refLst '(
                ("FOO-BAR-E" . "FOO-BAR-N")
                ("FOO-CAR-E" . "FOO-CAR-N")
                )
       )  
 (defun *error* (e)
   (if ov (mapcar 'setvar vl ov))
   (ObjRel (list Shell dbx *acad))
   (if (not (wcmatch (strcase e) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " e " >>")))
   (princ))
 (setq *acad (vlax-get-acad-object)
       Shell (vla-getInterfaceObject *acad "Shell.Application")
       fDir (vlax-invoke-method Shell 'BrowseForFolder
              (vla-get-HWND *acad) "Select Directory: " 0))
 (if fDir
   (progn
     (setq Dir
       (vlax-get-property
         (vlax-get-property fDir 'Self) 'Path))
     (if (not (eq "\" (substr Dir (strlen Dir))))
       (setq Dir (strcat Dir "\")))
     (if (< (atoi (setq acVer (substr (getvar "ACADVER") 1 2))) 16)
       (setq acVer "") (setq acVer (strcat (chr 46) acVer)))
     (setq dbx (vla-getInterfaceObject
                 *acad (strcat "ObjectDBX.AxDbDocument" acVer)))
     (princ "\nProcessing...")
     (foreach dwg (setq dwLst
                    (mapcar
                      (function
                        (lambda (x)
                          (strcat Dir x)))
                      (vl-directory-files Dir "*.dwg" 1)))
       (vla-open dbx dwg)
       (vlax-for Lay (vla-get-layouts dbx)
         (vlax-for Obj (vla-get-Block lay)
           (if (setq Tag (assoc (vla-get-layer Obj) refLst))
             (vla-put-layer Obj (cdr Tag)))))
       
       (vla-saveas dbx dwg)        
       (princ (chr 46)))
     (princ (strcat "\n<< " (rtos (length dwLst) 2 0) " Drawings Processed >>"))))
 
 (ObjRel (list Shell dbx *acad))
 (gc)
 (princ))
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))