Topic: DXF Table Dump - an old routine that i use a lot...

[efernal]

Code: [Select]

;; by Eduardo Fernal, 01/2000
(DEFUN c:dxt (/ tabela item)
  (SETVAR "CMDECHO" 0)
  ;; Portuguese
  ;|
  (SETQ tabela (GETSTRING "\n-> Tabela a pesquisar (layer, style, etc...) : "))
  (SETQ item (GETSTRING "\n-> O que pesquisar nesta tabela ? : \n\n"))
  |;
  ;; In my bad english
  (SETQ tabela ;|table|;
         (GETSTRING "\n-> Source table (layer, style, ltype, etc...) : ")
  )
  (SETQ item (GETSTRING "\n-> Wich item do you want to see ? : "))
  (IF (AND tabela
           (MEMBER (STRCASE tabela 1) '("layer" "ltype" "block" "style" "dimstyle"))
           item
           (TBLSEARCH tabela item)
      )
    (PROGN (PRINC "\n-> Resultado : \n")
           (FOREACH x (ENTGET (TBLOBJNAME tabela item)) (PRINT x))
           (TEXTPAGE)
    )
    ;; (alert "Erro: tabela e/ou itens não existem...")
    (ALERT "Error: Table and/ou item does not exists...")
  )
  (PRINC "\n\n")
  (PRINC)
)

;|
example


Command:
Command: dxt
-> Source table (layer, style, ltype, etc...) : layer
-> Wich item do you want to see ? : 0

-> Resultado :

(-1 . <Entity name: 7ef01c80>)
(0 . "LAYER")
(5 . "10")
(102 . "{ACAD_XDICTIONARY")
(360 . <Entity name: 7ef030f0>)
(102 . "}")
(330 . <Entity name: 7ef01c10>)
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(2 . "0")
(70 . 0)
(62 . 7)
(6 . "Continuous")
(290 . 1)
(370 . -3)
(390 . <Entity name: 7ef01c78>)
(347 . <Entity name: 7ef01f00>)

|;


[CAB]

English version.
Thanks for sharing Eduardo 

Code: [Select]

;; by Eduardo Fernal, 01/2000
(defun c:dxt (/ tabela item)
  (setvar "CMDECHO" 0)
  (setq tabela ;|table|;
         (getstring "\n-> Source table (layer, style, ltype, etc...) : ")
  )
  (setq item (getstring "\n-> Which item do you want to see ? : "))
  (if (and tabela
           (member (strcase tabela 1) '("layer" "ltype" "block" "style" "dimstyle"))
           item
           (tblsearch tabela item)
      )
    (progn (princ "\n-> Result : \n")
           (foreach x (entget (tblobjname tabela item)) (print x))
           (textpage)
    )
    (alert "Error: Table and/or item does not exists...")
  )
  (princ "\n\n")
  (princ)
)

[Lee Mac]

Hi Eduardo,

This is how I might approach it, using my sub from here:

Code: [Select]

(defun c:dxt ( / table item )

  (initget 1 "LAYER LTYPE VIEW STYLE BLOCK UCS APPID DIMSTYLE VPORT")
  (setq table (getkword "\nSource Table [LAYER/LTYPE/VIEW/STYLE/BLOCK/UCS/APPID/DIMSTYLE/VPORT]: "))

  (while (not (tblsearch table (setq item (getstring t (strcat "\nSpecify Item from " table " table: ")))))
    (princ "\n** Object not present in Table **")
  )
  (LM:EntityList (tblobjname table item))
  (princ)
)

[HofCAD]

Small change because of initget:

Code: [Select]

(defun c:TabDxf (/ Table Item)
  (initget 1
   "Appid Block Dimstyle LAyer LType Style Ucs View VPort"
  )
  (setq Table
(getkword
   "\n-> Which source table [Appid/Block/Dimstyle/LAyer/LType/Style/Ucs/View/VPort]: "
)
  )
  (while
    (not
      (tblsearch
Table
(setq
  Item (getstring
t
(strcat "\nSpecify object from " Table " table: ")
       )
)
      )
    )
     (princ
       (strcat "\n** Object not present in " Table " table **")
     )
  )
  ($TabDxf nil Table Item)
)
(defun $TabDxf (NotOKe Table Item)
  (if NotOKe
    (progn
      (if (and Table
       (member (strcase Table 1)
       '("appid"    "block"    "dimstyle" "layer"
"ltype"    "style"    "ucs"   "view"
"vport"
)
       )
       Item
       (tblsearch Table Item)
  )
(progn (princ "\n-> Result : \n")
       (foreach x (entget (tblobjname Table Item)) (print x))
       (textpage)
)
(alert "Error: Table and/or Item does not exists...")
      )
    )
    (progn (princ "\n-> Result : \n")
   (foreach x (entget (tblobjname Table Item)) (print x))
   (textpage)
    )
  )
  (princ "\n\n")
  (princ)
)
(princ "\nType TABDXF to run.")


Code: [Select]

($TabDxf T "layer" "0")
Regards HofCAD CSI