普通LINE,文字实体转换为表格

Lispboy

将选择的TEXT,MTEXT，线，块（属性块）转换成表格实体。

需要在 2016.11.15以上版本的XDRX API下运行。

[sell]

(defun c:XDTB_TableConvert (/ #style #textheight area1 area2 att att1 blks box box1 col e
               el el1 ents gap h key pts rc row ss ss1 ss2 tb x y
            )
  (defun _gettbdata (col)
    (if (= (type col) 'ENAME)
      (progn
        (setq pts (xdrx_getpropertyvalue col "vertices"))
        (cond
          ((setq ss2 (ssget "wp" pts '((0 . "*TEXT"))))
            (setq ss2 (mapcar
                        '(lambda (y)
                           (xdrx_getpropertyvalue y "textheight")
                           (setq #style (car (xdrx_getpropertyvalue y "textstyle")))
                           (xdrx_getpropertyvalue y "textstring")
                         )
                        (xdrx_pickset->ents ss2)
                      )
            )
            (apply
              'strcat
              ss2
            )
          )
          ((setq ss2 (ssget "cp" pts '((0 . "INSERT"))))
            (setq e (ssname ss2 0)
                  ss2 (cadr (xdrx_getpropertyvalue e "blocktablerecord"))
            )
            (if (setq att (xdrx_getpropertyvalue e "AttributeEntities"))
              (progn
                (setq blks (xdrx_block_getentities ss2 '((0 . "att*")))
                      att1 (car blks)
                )
                (setq ss2 (list ss2 att1 (xdrx_getpropertyvalue
                                                                (car att) "textstring"
                                         )
                          )
                )
              )
            )
            ss2
          )
          (t
            (setq ss2 "")
          )
        )
      )
      nil
    )
  )
  (defun _getdata (ss)
    (if (and
          (setq el1 (xdrx_pickset->ents ss)
                ss1 (xd::pickset:getsub ss '((0 . "LINE,*POLYLINE")))
                ss1 (xdrx_curve_intersectbreak ss1)
                ss1 (xdrx_geom_searchregions ss1 0.0)
          )
        )
      (progn
        (setq box (xdrx_entity_box (cons ss1 el1))
              area1 (abs (apply
                           'xdrx_points_area
                           box
                         )
                    )
        )
        (setq e (xdrx_polyline_make box t)
              ss1 (xdrx_entity_explode ss1)
              ss1 (ssadd e ss1)
              ss1 (xdrx_curve_intersectbreak ss1)
              ss1 (xdrx_geom_searchregions ss1 0.0)
              el (xdrx_pickset->ents ss1)
        )
        (setq el (mapcar
                   '(lambda (x)
                      (setq area2 (xdrx_getpropertyvalue x "area"))
                      (if (equal area1 area2 1e-3)
                        (entdel x)
                        x
                      )
                    )
                   el
                 )
        )
        (setq el (vl-remove nil el))
        (setq e (car el)
              box1 (xdrx_entity_box e)
              h (distance (last box1) (car box1))
        )
        (xdrx_document_setprec (/ h 2.0) 1)
        (setq el (xd::pickset:tablesort ss1 0 2 '> '<)
              el (xd::table:fillgap el "")
              rc (xd::list:istable el)
        )
        (setq el (mapcar
                   '(lambda (row)
                      (mapcar
                        '(lambda (col)
                           (_gettbdata col)
                         )
                        row
                      )
                    )
                   el
                 )
        )
      )
      nil
    )
  )
  (defun _keyword (key)
    (cond
      ((= key "BJ")
        (if (setq gap (getint (xdrx_prompt "\n输入字到单元格边线距离系数(字高比值)<"
                                           #table_gap ">:" t
                              )
                      )
            )
          (setq #table_gap gap)
        )
      )
    )
    (xdrx_prompt "\n当前设置：字边距系数(" #table_gap ")")
  )
  (defun _settablehead ()
    (if (vl-every '(lambda (x)
                     (or
                       (= x "")
                       (= x nil)
                     )
                   ) (cdar el)
        )
      (progn
        (if (= (type (caaar el)) 'ENAME)
          (progn
            (if (xdrx_getpropertyvalue (caaar el) "HasAttributeDefinitions")
              (xdrx_setpropertyvalue tb "blockattributevalue" (list 0 0
                                                                    (cadr
                                                                          (caar el)
                                                                    )
                                                                    (last
                                                                          (caar el)
                                                                    )
                                                              )
              )
            )
            (xdrx_setpropertyvalue tb "autoscale" (list 0 0 nil)
                                   "blockscale" (list 0 0 1.0)
                                   "gridvisibility" (list 0 -1 41 1)
                                   "suppressTitleRow" nil
            )
          )
        )
      )
      (xdrx_setpropertyvalue tb "unmergecells" (list 0 0 0 (1-
                                                               (length
                                                                       (car el)
                                                               )
                                                           )
                                               ) "suppressTitleRow" t
      )
    )
  )
  (if (not #table_gap)
    (setq #table_gap 2)
  )
  (xdrx_prompt "\n当前设置：字边距系数(" #table_gap ")")
  (xdrx_initssget "\n选取要转换表格的线,文字实体[字边距(BJ)]<退出>" "BJ"
                  "移除不转换的实体[添加(A)]<退出>:" "_keyword" ""
  )
  (if (setq ss (xdrx_ssget '((0 . "LINE,*POLYLINE,*TEXT,INSERT"))))
    (progn
      (xdrx_begin)
      (xdrx_setmark)
      (setq ents (xdrx_pickset->ents ss))
      (if (setq el (_getdata ss))
        (progn
          (setq tb (xdrx_table_make (last box) (car rc) 1 (cadr rc) 1))
          (xdrx_setpropertyvalue tb "textstyle" #style "alignment" 5
                                 "textheight" #textheight "horzcellmargin"
                                 (/ #textheight #table_gap) "vertcellmargin"
                                 (/ #textheight #table_gap) "textstring" el
                                 "autosize"
          )
          (_settablehead)
          (setq ss1 (xdrx_getss)
                ss1 (ssdel tb ss1)
          )
          (xdrx_entity_delete ents ss1)
        )
        (xdrx_prompt "\n选择的线构不成表格.")
      )
      (xdrx_end)
    )
  )
  (princ)
)

[/sell]

longer1000

正需要，支持楼主大人了！

lucas3

以前牢固版主也用API写过

yanchao316

回的人少，我来小顶一下........

bnjzzheng

这个相当不错啊正需要，支持楼主大人了！

whdong76

啥也不说了，感谢楼主分享哇！

scnjlwb

谢谢分享！

kqqt6236

谢谢分享。

dyjwyqz5221

看看如何使用

liutong1997

不错，不错，不错，谢谢分享

kiwiairui

                    

dyjwyqz5221

一定购买，需要

dyjwyqz5221

购买购买，手机上看不到购买位置

dyjwyqz5221

很不错，很不错

renyonghua2014

实用，谢谢分享。