属性块的属性批量导出和导入

maiqi816 · 发表于 2016-5-8 10:56:26

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

用多段线把属性块连接起来，选择多段线，按照通过多段线顶点的顺序，把属性块的属性和坐标批量导出到excel，再把在excel中修改的属性导入到图形中去，非常感谢，我的QQ:2401979811

iLisp · 发表于 2016-5-8 11:02:51

坐标有必要吗？只改属性的话，记录属性文字的句柄标签和值即可

maiqi816 · 发表于 2016-5-8 11:04:44

有必要，因为这个坐标我会导入到**软件中去

csharp · 发表于 2016-5-8 11:52:53

本帖最后由 csharp 于 2016-5-8 11:54 编辑

输出部分

(defun c:XDTB_ATTsToXLS (/ getatts e box pts ss lst isoutscr flag )
(defun getatts (ss / lst alst)
(setq lst (mapcar '(lambda (x / p handle)
(mapcar 'set
'(handle p)
(xdrx_getpropertyvalue x "handle" "position")
)
(cons handle
(cons
(list "Xcoord" (rtos (car p) 2 3))
(cons (list "Ycoord" (rtos (cadr p) 2 3))
(cons
(list "Zcoord" (rtos (caddr p) 2 3))
(mapcar '(lambda (a) (xdrx_getpropertyvalue a "tag" "textstring"))
(xdrx_insert_getattribs x)
)
)
)
)
)
)
(xdrx_pickset->ents ss)
)
alst (cons "Xcoord"
(cons "Ycoord"
(cons "Zcoord"
(acad_strlsort
(xd::list:removedup
(mapcar 'strcase
(apply 'append
(mapcar '(lambda (x) (mapcar 'car x)) (mapcar 'cddddr lst))
)
)
)
)
)
)
)
)
(cons (cons "" alst)
(mapcar '(lambda (x)
(cons (car x)
(mapcar '(lambda (a / l)
(if (setq l (assoc a (cdr x)))
(cadr l)
""
)
)
alst
)
)
)
lst
)
)
)
(defun isoutscr (pts / ptl box)
(setq ptl (xd::doc:getview4pnt)
box (xdrx_points_box pts)
)
(or (< (caar box) (caar ptl))
(< (cadar box) (cadar ptl))
(> (caaddr box) (caaddr ptl))
(> (cadr (caddr box)) (cadr (caddr ptl)))
)
)
(if (and (setq e (car (xdrx_entsel "\n拾取Pline: " '((0 . "lwpolyline")))))
(setq box (xdrx_entity_box e))
(if (isoutscr (xd::pnts:wcs2ucs box))
(progn
(xdrx_document_zoomentities e)
(setq flag t)
)
t
)
(setq pts (xdrx_getsamplept e))
(setq ss (ssget "f" pts '((0 . "Insert") (66 . 1))))
)
(progn
(setvar "dimzin" 0)
(setq lst (getatts ss))
(xd::excel:createtofile
(setq str (strcat (getvar "dwgprefix")
(vl-filename-base (getvar "dwgname"))
".xls"
)
)
lst
)
(princ (strcat "\nWrite out " str " Ok!"))
(if flag
(xdrx_document_zoomPrevious)
)
)
)
(princ)
)

(defun c:XDTB_ATTsToXLS        (/ getatts e box pts ss lst isoutscr flag ) 
  (defun getatts (ss / lst alst) 
    (setq lst  (mapcar '(lambda        (x / p handle) 
                          (mapcar 'set 
                                  '(handle p) 
                                  (xdrx_getpropertyvalue x "handle" "position") 
                          ) 
                          (cons        handle 
                                (cons 
                                  (list "Xcoord" (rtos (car p) 2 3)) 
                                  (cons        (list "Ycoord" (rtos (cadr p) 2 3)) 
                                        (cons 
                                          (list "Zcoord" (rtos (caddr p) 2 3)) 
                                          (mapcar '(lambda (a) (xdrx_getpropertyvalue a "tag" "textstring")) 
                                                  (xdrx_insert_getattribs x) 
                                          ) 
                                        ) 
                                  ) 
                                ) 
                          ) 
                        ) 
                       (xdrx_pickset->ents ss) 
               ) 
          alst (cons "Xcoord" 
                     (cons "Ycoord" 
                           (cons "Zcoord" 
                                 (acad_strlsort 
                                   (xd::list:removedup 
                                     (mapcar 'strcase 
                                             (apply 'append 
                                                    (mapcar '(lambda (x) (mapcar 'car x)) (mapcar 'cddddr lst)) 
                                             ) 
                                     ) 
                                   ) 
                                 ) 
                           ) 
                     ) 
               ) 
    ) 
    (cons (cons "" alst) 
          (mapcar '(lambda (x) 
                     (cons (car x) 
                           (mapcar '(lambda (a / l) 
                                      (if (setq l (assoc a (cdr x))) 
                                        (cadr l) 
                                        "" 
                                      ) 
                                    ) 
                                   alst 
                           ) 
                     ) 
                   ) 
                  lst 
          ) 
    ) 
  ) 
  (defun isoutscr (pts / ptl box) 
    (setq ptl (xd::doc:getview4pnt) 
          box (xdrx_points_box pts) 
    ) 
    (or        (< (caar box) (caar ptl)) 
        (< (cadar box) (cadar ptl)) 
        (> (caaddr box) (caaddr ptl)) 
        (> (cadr (caddr box)) (cadr (caddr ptl))) 
    ) 
  ) 
  (if (and (setq e (car (xdrx_entsel "\n拾取Pline: " '((0 . "lwpolyline"))))) 
           (setq box (xdrx_entity_box e)) 
           (if (isoutscr (xd::pnts:wcs2ucs box)) 
             (progn 
               (xdrx_document_zoomentities e) 
               (setq flag t) 
             ) 
             t 
           ) 
           (setq pts (xdrx_getsamplept e)) 
           (setq ss (ssget "f" pts '((0 . "Insert") (66 . 1)))) 
      ) 
    (progn 
      (setvar "dimzin" 0) 
      (setq lst (getatts ss)) 
      (xd::excel:createtofile 
        (setq str (strcat (getvar "dwgprefix") 
                          (vl-filename-base (getvar "dwgname")) 
                          ".xls" 
                  ) 
        ) 
        lst 
      ) 
      (princ (strcat "\nWrite out " str " Ok!")) 
      (if flag 
        (xdrx_document_zoomPrevious) 
      ) 
    ) 
  ) 
  (princ) 
)

maiqi816 · 发表于 2016-5-8 13:19:55

这个需要需要xd库函数！且不是按照多段线顺序！

iLisp · 发表于 2016-5-8 14:45:53

maiqi816 发表于 2016-5-8 13:19
这个需要需要xd库函数！且不是按照多段线顺序！

你怎么知道不是按多段线顺序的？

maiqi816 · 发表于 2016-5-8 15:11:45

命令: XDTB_ATTsToXLS
拾取Pline: ; 错误: no function definition: XD::PNTS:WCS2UCS

iLisp · 发表于 2016-5-8 15:26:03

加载xdrxapi 和 xd-lisp-lib.vlx

newer · 发表于 2016-5-8 15:46:05

maiqi816 发表于 2016-5-8 15:11
命令: XDTB_ATTsToXLS
拾取Pline: ; 错误: no function definition: XD:NTS:WCS2UCS

安装晓东工具箱，然后就一劳永逸了。

maiqi816 · 发表于 2016-5-8 15:47:56

估计我下载的不对，我加载了不行，你能发给我吗？！

newer · 发表于 2016-5-8 15:54:33

maiqi816 发表于 2016-5-8 15:47
估计我下载的不对，我加载了不行，你能发给我吗？！

估计如何加载API和LISP函数库对一些朋友还是个问题，去这个链接 http://bbs.xdcad.net/thread-703851-1-1.html ，下载晓东工具箱，安装一次，环境就都有了。而且每日插件论坛里面的插件都可以运行在这个下面的。

maiqi816 · 发表于 2016-5-8 15:55:27

可以用了但是这个有个问题，我修改了数据不能导入进去了！

maiqi816 · 发表于 2016-5-8 16:01:40

我上传了一个图片，能增加一个块名称，把坐标调整到后面，我可以把excel数据另存为TXT 利用attin导入

newer · 发表于 2016-5-8 16:13:05

maiqi816 发表于 2016-5-8 16:01
我上传了一个图片，能增加一个块名称，把坐标调整到后面，我可以把excel数据另存为TXT 利用attin导入

你修改后的EXCEL文件，再导入到CAD更新属性，论坛以前提供过插件。

maiqi816 · 发表于 2016-5-8 16:36:06

哪里有能发给我吗？

账号		自动登录	找回密码
密码			立即注册

[编程申请] 属性块的属性批量导出和导入

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

浏览过的版块