社区 › Auto Lisp › 从一个层移动对象

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的东西，所以有点碰运气……）
 

;; ObjectDBX Testerby 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))

Lee Mac 发表于 2022-7-6 15:04:32

 
你为什么要学习VBA？我以为那已经灭绝了。。。

wannabe 发表于 2022-7-6 15:04:54

 
我认为没有。NET API for Microstation。今年早些时候我最后一次检查的时候没有。
 
宾利论坛将告诉我们所有人。

wannabe 发表于 2022-7-6 15:10:23

http://www.la-solutions.co.uk/content/MicroStationDevelopmentLanguages.htm#.NET
 
我们开始吧。大体上NET只使用COM互操作。现在我记得为什么我推迟了一些Microstation应用程序的编程。

ABuckingham 发表于 2022-7-6 15:20:35

没有运气，同样的错误。
 
>

查看完整版本: 从一个层移动对象