提取块p的属性
你好是否可以提取特定图形中块的特性（即块名称、x坐标、y坐标和旋转），并打印逗号分隔的文本文件输出？
示例文本文件输出如下所示：
谢谢。 查看DATAEXTRACTION命令。 数据提取更为完整，我最近碰巧编写了一些类似的代码，我想我会发布。从这里拿走你想要的。
(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")))
谢谢大家。数据提取命令提供了非常详细的输出和非常强大的功能。RenderMan，太酷了，我从没想过lisp能做到这一点。
由于我不需要这个命令，我经常忘记它（因此代码）。
你这么说真是太好了；李和其他许多人帮助我学到了很多我现在知道的东西。 RenderMan，我遇到了一个错误，没有打开临时文件下的csv文件。我刚刚修改了路径名，效果很好。以下是适用于我的代码：
(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")))
这很奇怪，因为它（我发布的代码）不仅在我这方面工作得很好，而且根据开发人员文档，它使用了您环境的临时设置。
有关vl Filename Mktemp函数的详细信息。
与其硬编码每个用户的位置，不如识别一个适用于您的设置的公共目录，并使用（getvar的loginname）消除每个用户修改的需要。只是一个想法。 我又试了一次，现在可以用了。我不知道为什么昨天命令后csv文件没有打开。可能问题是我没有等足够长的时间让lisp打开它，因为我试了几次，然后被迫手动定位文件。
非常感谢，我将使用你的原始代码。 代码中的错误是
(defun c:BlockProp
...
(setq path C:\\Users\\ZAGM01373\\Documents\\Batman.csv")
应该是
4 好话题Bª™ªN
这也非常慷慨地让你分享了RenderMan的代码，谢谢你，
页:
[1]
2