提取块p的属性

Bª™ªN1534592500 · 发表于 2022-7-6 07:46:59

你好

是否可以提取特定图形中块的特性（即块名称、x坐标、y坐标和旋转），并打印逗号分隔的文本文件输出？

示例文本文件输出如下所示：

谢谢。

Lee Mac · 发表于 2022-7-6 07:57:47

查看DATAEXTRACTION命令。

BlackBox · 发表于 2022-7-6 08:02:20

数据提取更为完整，我最近碰巧编写了一些类似的代码，我想我会发布。从这里拿走你想要的。


(defun c:BlockProp  (/ *error* ss path acApp acDoc oShell file coord)
 ;; RenderMan, 2012
 (princ "\rBLOCKPROP ")
 (vl-load-com)
 (defun *error*  (msg)
   (if oShell (vlax-release-object oShell))
   (if file (close file))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
   (princ))
 (if (and (setq ss (ssget "_x" '((0 . "INSERT"))))
          (setq path
                 (strcat (vl-filename-directory (vl-filename-mktemp))
                         "\\Block Properties.csv"))
          (setq acApp (vlax-get-acad-object))
          (setq acDoc (vla-get-activedocument acApp))
          (setq oShell
                 (vla-getinterfaceobject acApp "Shell.Application")))
   (progn
     (setq file (open path "w"))
     (write-line "BLOCK PROPERTIES" file)
     (write-line "" file)
     (write-line
       (strcat "Drawing:, , " (getvar 'dwgprefix) (getvar 'dwgname))
       file)
     (write-line
       (strcat "Date:, , "
               (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD)"))
       file)
     (write-line "" file)
     (write-line "NAME, X, Y, Z, ROTATION" file)
     (vlax-for oBlock
               (setq ss (vla-get-activeselectionset acDoc))
       (write-line
         (strcat
           (vla-get-effectivename oBlock)
           ","
           (rtos
             (car (setq coord (vlax-get oBlock 'insertionpoint))))
           ","
           (rtos (cadr coord))
           ","
           (rtos (caddr coord))
           ","
           (rtos (vla-get-rotation oBlock)))
         file))
     (setq file (close file))
     (vlax-invoke oShell 'open path)
     (*error* nil))
   (*error* "No blocks found")))

Bª™ªN1534592500 · 发表于 2022-7-6 08:05:10

谢谢大家。数据提取命令提供了非常详细的输出和非常强大的功能。RenderMan，太酷了，我从没想过lisp能做到这一点。

BlackBox · 发表于 2022-7-6 08:15:54

由于我不需要这个命令，我经常忘记它（因此代码）。

你这么说真是太好了；李和其他许多人帮助我学到了很多我现在知道的东西。

Bª™ªN1534592500 · 发表于 2022-7-6 08:17:19

RenderMan，我遇到了一个错误，没有打开临时文件下的csv文件。我刚刚修改了路径名，效果很好。以下是适用于我的代码：

copy

(defun c:BlockProp  (/ *error* ss path acApp acDoc oShell file coord)
 ;; RenderMan, 2012
 (princ "\rBLOCKPROP ")
 (vl-load-com)
 (defun *error*  (msg)
   (if oShell (vlax-release-object oShell))
   (if file (close file))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
   (princ))
 (if (and (setq ss (ssget "_x" '((0 . "INSERT"))))
          (setq path C:\\Users\\ZAGM01373\\Documents\\Batman.csv") ;Please change this to your preferred file path and name
          (setq acApp (vlax-get-acad-object))
          (setq acDoc (vla-get-activedocument acApp))
          (setq oShell
                 (vla-getinterfaceobject acApp "Shell.Application")))
   (progn
     (setq file (open path "w"))
     (write-line "BLOCK PROPERTIES" file)
     (write-line "" file)
     (write-line
       (strcat "Drawing:, , " (getvar 'dwgprefix) (getvar 'dwgname))
       file)
     (write-line
       (strcat "Date:, , "
               (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD)"))
       file)
     (write-line "" file)
     (write-line "NAME, X, Y, Z, ROTATION" file)
     (vlax-for oBlock
               (setq ss (vla-get-activeselectionset acDoc))
       (write-line
         (strcat
           (vla-get-effectivename oBlock)
           ","
           (rtos
             (car (setq coord (vlax-get oBlock 'insertionpoint))))
           ","
           (rtos (cadr coord))
           ","
           (rtos (caddr coord))
           ","
           (rtos (vla-get-rotation oBlock)))
         file))
     (setq file (close file))
     (vlax-invoke oShell 'open path)
     (*error* nil))
   (*error* "No blocks found")))

BlackBox · 发表于 2022-7-6 08:26:52

这很奇怪，因为它（我发布的代码）不仅在我这方面工作得很好，而且根据开发人员文档，它使用了您环境的临时设置。

有关vl Filename Mktemp函数的详细信息。

与其硬编码每个用户的位置，不如识别一个适用于您的设置的公共目录，并使用（getvar的loginname）消除每个用户修改的需要。只是一个想法。

Bª™ªN1534592500 · 发表于 2022-7-6 08:33:53

我又试了一次，现在可以用了。我不知道为什么昨天命令后csv文件没有打开。可能问题是我没有等足够长的时间让lisp打开它，因为我试了几次，然后被迫手动定位文件。

非常感谢，我将使用你的原始代码。

asos2000 · 发表于 2022-7-6 08:38:00

代码中的错误是

copy

(defun c:BlockProp
...
          (setq path [color="red"]C[/color]:\\Users\\ZAGM01373\\Documents\\Batman.csv")

应该是

copy

goØn · 发表于 2022-7-6 08:43:27

好话题Bª™ªN

这也非常慷慨地让你分享了RenderMan的代码，谢谢你，

[编程交流] 提取块p的属性

发表回复

精选推荐