我添加了一个带有几个属性块的dwg。
命令是BLOCKS(我喜欢将客户端可访问的函数作为最后一个函数编写)
这会将数据导出到“block_export.txt”,与dwg位于同一文件夹中(因此请不要在未保存的图形上使用此选项)
要求:值中的每个双引号必须在中转义。txt文件,以便将其解析为lisp数据
(vl-load-com)
(defun blocks ( / iterations i block attString content_string)
;; select blocks (all blocks in the dwg)
(setq
blocks (ssget "X" (list
'(0 . "INSERT")
))
iterations (sslength blocks) ;; number of iterations
i 0
block nil
content_string "" ;; this is the variable containing the content we will save to file
)
(repeat iterations ;; loop over blocks
(setq block (ssname blocks i))
;; attributes
(setq attString "")
(foreach att (vlax-invoke (vlax-ename->vla-object block) 'GetAttributes)
(setq attVal (vla-get-TextString att))
(setq tag (vla-get-TagString att))
(setq attVal (escape attVal))
(setq attString (strcat attString "(\"" tag "\" \""attval "\") "))
)
(setq content_string (strcat content_string "("attString ")\n" ))
(setq i (+ 1 i))
)
;; this prints the contents to file.The file is "block_export.txt" , in the same folder as the dwg.
;; Notice: save the dwg before using this
(file_put_contents (strcat (getvar 'dwgprefix) "block_export.txt") content_string)
)
;; http://forums.autodesk.com/t5/visual...e/td-p/3732910
(defun replace (newstr oldstr str / localstr)
(setq localstr str)
(while (vl-string-search oldstr localstr)
(setq localstr (vl-string-subst newstr oldstr localstr))
(replace newstr oldstr localstr)
)
localstr
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; file IO.
;; made to look like the php-functions file_put_contents & file_get_contents
;; (Not sure where I found these and how much of it I wrote my self)
;; saves a string to file
(defun file_put_contents (file_name content / result f)
(setq result T)
(if (setq f (open file_name "w"))
(progn
(write-line content f)
(close f)
)
(progn
(setq result NIL)
)
)
result
)
;; read file as string
(defun file_get_contents (file_name / content)
(setq content "")
(if(setq fp (open file_name "r")) ; file pointer
(progn
(while (setq txtLine(read-line fp))
(setq content (strcat content "\n" txtLine))
)
(close fp)
content ; return content
)
(progn
NIL ; return false
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun _add:slash (st)
(if (wcmatch st "*\"")
(strcat (substr st 1 (1- (strlen st))) (chr 92) (chr 34))
)
st
)
(defun escape(str / )
;;(replace "\"" "\\\"" str)
(_add:slash str)
)
(defun c:blocks ( / )
(blocks)
(princ)
)
注意:
-函数替换目前未使用。
-file\u get\u内容根本没有使用;但是因为我提供了file\u put\u内容,所以我也可以提供file\u get\u内容。
图纸2.dwg 试试这个,让我知道。
(defun c:test (/ _add:slash ss i block l f o)
;; Tharwat 18.12.2014 ;;
(defun _add:slash (st)
(if (wcmatch st "*\"")
(setq
st (strcat (substr st 1 (1- (strlen st))) (chr 92) (chr 34))
)
st
)
st
)
(if (setq ss (ssget "_X" '((0 . "INSERT"))))
(progn
(setq f (strcat (getvar 'dwgprefix) "block_export22.txt")
o (open f "w")
)
(repeat (setq i (sslength ss))
(foreach x
(vlax-invoke
(vlax-ename->vla-object (ssname ss (setq i (1- i))))
'getattributes
)
(setq l (cons (strcat "("
(chr 34)
(vla-get-tagstring x)
(chr 34)
" "
(chr 34)
(_add:slash (vla-get-textstring x))
(chr 34)
")"
)
l
)
)
)
(write-line (vl-princ-to-string l) o)
(setq l nil)
)
(close o)
)
)
(princ)
)(vl-load-com)
它适用于属性,其中“是最后一个字符;谢谢。
当“在字符串中间的某个地方时,它仍然不起作用。
但我很确定从现在起我能找到答案。
很好,听到这个消息我很高兴。
祝你好运,不要犹豫,如果你坚持任何。
注意:我只是为了测试而更改了txt文件的名称,但忘记了按原样返回,所以只需从标题中删除两个2号即可。
当做 顺便说一句,最好添加过滤器(66.1),使其仅在选择集中包含属性块。 是的,我知道,但我也需要没有属性的块。正如我所说,这是代码的一个简短版本,整个程序做了一些额外的事情。
页:
1
[2]