Jump to content

Help: TXT to Tab

mhy3sx

By mhy3sx
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mhy3sx Community Regular

mhy3sx

Posted
Posted (edited)

Hi I am trying to insert a txt file with coordinates to tab with specific column width. The table created but is not correct and not fill with text. I attach a coordinate file for the code test.

  

(defun c:txt2tab (/ *error* del des hdl ins lin lst txt scl hgt) 
  (setq scl (getvar "useri1"))
  (setq hgt (* 0.0005 scl))

  (defun *error* (msg)
    (if (= 'file (type des))
      (close des)
    )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (if (setq txt (getfiled "choose a file   P,X,Y (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (mapcar '(lambda (a b) a) (LM:str->lst lin del)) lst))
        )
        (setq des (close des))
        (if lst ;; Do we have a valid list?
          (if (setq ins (getpoint "\nSpecify point for table: "))
            (progn
              (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
              (setq tlst (cons (list "A/A" (strcat "X" (if iunits (strcat "") " (?)")) (strcat "Y" (if iunits (strcat "") " (?)"))) tlst));
              (initget "1 2")
              (setq t_spc (cond ((getkword "\niNSERT TABLE : ? [1.Modelspace/2.Paperspace] <1>") "1")))
              (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))
              (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" tlst)
              (vl-cmdf "_SCALE" (entlast) "" ins hgt)
            )
          )
          (princ "\nNo valid data found in selected file.")
        )
        (princ "\nUnable to open selected file for reading.")
      )
    )
    (princ)
  )
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
)

(defun rh:AMT (doc title lst / spc ipt t_obj rows cols row cell rdat)
  (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
  (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        ipt (getpoint "\nSelect Table Insertion Point: ")
        t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5))
  (vla-put-regeneratetablesuppressed t_obj :vlax-true)
  (mapcar '(lambda (x y) (vlax-put-property t_obj x y)) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
  (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

  ;; Title row
  (vlax-invoke t_obj 'setrowheight 0 10.0)
  (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
  (vlax-invoke t_obj 'settext 0 0 title)

  (setq rows (- (vlax-get t_obj 'rows) 2)
        cols (1- (vlax-get t_obj 'columns))
        row 1
        cell 0)

  ;; Loop through data cells
  (while (< row rows)
    (setq rdat (nth (- row 1) lst))
    (while (<= cell cols)
      (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
      (vlax-invoke t_obj 'settext row cell (nth cell rdat))
      (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
      (setq cell (1+ cell))
    )
    (setq row (1+ row) cell 0)
  )

  (vlax-invoke t_obj 'setcellalignment 1 0 acMiddleCenter)
  (vlax-invoke t_obj 'setcellalignment 2 0 acMiddleCenter)

  (repeat 2
    (vlax-invoke t_obj 'setrowheight row 6.0)
    (vlax-invoke t_obj 'mergecells row row 0 cols)
    (setq rdat (nth (1- row) lst))
    (vla-put-width t_obj 75)
    (vla-setcolumnwidth t_obj 0 15)
    (vla-setcolumnwidth t_obj 1 30)
    (vla-setcolumnwidth t_obj 2 30)
    (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
    (vlax-invoke t_obj 'settext row 0 (car rdat))
    (setq row (1+ row))
  )
  (vla-put-regeneratetablesuppressed t_obj :vlax-false)
)

 

 

Thanks

TEST.TXT

Edited by mhy3sx
mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted (edited)

I try to update the code but

  

Error: too few arguments

  

(defun c:txt2tab (/ *error* del des hdl ins lin lst txt scl hgt)
  (setq scl (getvar "useri1"))
  (setq hgt (* 0.0005 scl))

  (defun *error* (msg)
    (if (= 'file (type des))
      (close des)
    )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  ;; Define your delimiter (e.g., comma, semicolon)
  (setq del ",")

  (if (setq txt (getfiled "Choose a file (P,X,Y) (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (mapcar '(lambda (a b) a) (LM:str->lst lin del)) lst))
        )
        (setq des (close des))
        (if lst ;; Do we have valid data?
          (if (setq ins (getpoint "\nSpecify point for table: "))
            (progn
              (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
              (initget "1 2")
              (setq t_spc (cond ((getkword "\nInsert table in Modelspace or Paperspace? [1.Modelspace/2.Paperspace] <1>") "1")))
              (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))
              (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" tlst)
              (vl-cmdf "_SCALE" (entlast) "" ins hgt)
            )
            (setq tlst (cons (list "A/A" (strcat "X" (if iunits (strcat "") " (?)")) (strcat "Y" (if iunits (strcat "") " (?)"))) tlst))
          )
          (princ "\nNo valid data found in the selected file.")
        )
        (princ "\nUnable to open the selected file for reading.")
      )
    )
    (princ)
  )
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
)



(defun rh:AMT (doc title lst / spc ipt t_obj rows cols row cell rdat)
  (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
  (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        ipt (getpoint "\nSelect Table Insertion Point: ")
        t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5))
  (vla-put-regeneratetablesuppressed t_obj :vlax-true)
  (mapcar '(lambda (x y) (vlax-put-property t_obj x y)) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
  (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

  ;; Title row
  (vlax-invoke t_obj 'setrowheight 0 10.0)
  (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
  (vlax-invoke t_obj 'settext 0 0 title)

  (setq rows (- (vlax-get t_obj 'rows) 2)
        cols (1- (vlax-get t_obj 'columns))
        row 1
        cell 0)

  ;; Loop through data cells
  (while (< row rows)
    (setq rdat (nth (- row 1) lst))
    (while (<= cell cols)
      (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
      (vlax-invoke t_obj 'settext row cell (nth cell rdat))
      (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
      (setq cell (1+ cell))
    )
    (setq row (1+ row) cell 0)
  )

  (vlax-invoke t_obj 'setcellalignment 1 0 acMiddleCenter)
  (vlax-invoke t_obj 'setcellalignment 2 0 acMiddleCenter)

  (repeat 2
    (vlax-invoke t_obj 'setrowheight row 6.0)
    (vlax-invoke t_obj 'mergecells row row 0 cols)
    (setq rdat (nth (1- row) lst))
    (vla-put-width t_obj 75)
    (vla-setcolumnwidth t_obj 0 15)
    (vla-setcolumnwidth t_obj 1 30)
    (vla-setcolumnwidth t_obj 2 30)
    (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
    (vlax-invoke t_obj 'settext row 0 (car rdat))
    (setq row (1+ row))
  )
  (vla-put-regeneratetablesuppressed t_obj :vlax-false)
)

 

Edited by mhy3sx
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

A couple of comments

  

Dont need this IF as the fileypes should be readable
Only time not readable is if you dont have permission to read a file

(setq des (open txt "r")) 

.................
see below

 

Need to add the LM:str->lst code into this code.

 

Dont need 

image.png.0e43faa5537f0c86612b9f514fb1feb3.png

 

rh:AMT is missing

 

It's very easy for other code to overwrite the USERIx values I use ldata.

  

(vlax-ldata-put "Mhy3sx" "Scl" scl) ; set default value if needed.

(setq scl (vlax-ldata-get "Mhy3sx" "Scl"))

 

Edited by BIGAL
mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted (edited)

Hi BIGAL. The code is not working and your tips don't help me. How to fix the code?

 

Quote

rh:AMT is missing

 

rh:AMT is in the code !!

 

 

Thanks

Edited by mhy3sx
mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted

I try this but Error: syntax error

  

(defun c:test (/ *error* del des hdl ins lin lst txt scl hgt)
  (setq scl (getvar "useri1"))
  (setq hgt (* 0.0005 scl))

  (defun *error* (msg)
    (if (= 'file (type des))
      (close des)
    )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  ;; Define your delimiter (e.g., comma, semicolon)
  (setq del ",")

  (if (setq txt (getfiled "Choose a file (P,X,Y) (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (mapcar '(lambda (a b) a) (LM:str->lst lin del)) lst))
        )
        (setq des (close des))
        (if lst ;; Do we have valid data?
          (if (setq ins (getpoint "\nSpecify point for table: "))
            (progn
              (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
              (initget "1 2")
              (setq t_spc (cond ((getkword "\nInsert table in Modelspace or Paperspace? [1.Modelspace/2.Paperspace] <1>") "1")))
              (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))
              (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" tlst)
              (vl-cmdf "_SCALE" (entlast) "" ins hgt)
            )
            (setq tlst (cons (list "A/A" (strcat "X" (if iunits (strcat "") " (?)")) (strcat "Y" (if iunits (strcat "") " (?)"))) tlst))



 (setq tlst (cons (list "A/A" (strcat "X" (if iunits (strcat "") " (?)")) (strcat "Y" (if iunits (strcat "") " (?)"))) tlst))


;---------------------------------------------------------------;
;                    Paper space                     ;
;---------------------------------------------------------------;

          (initget "1 2")
          (setq t_spc (cond ( (getkword "\nInsert table : ? [1.Modelspace/2.Paperspace] <1>")) ("1"))
          )
          (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))

;------------------------------------------------------------------------------------------------------------------------

          (rh:AMT c_doc (strcat "My Table " nme) tlst)
        )
        (t (alert "No Polyline Selected"))
         );end_if
          )
          (princ "\nNo valid data found in the selected file.")
        )
        (princ "\nUnable to open the selected file for reading.")
      )

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

(defun rh:AMT ( doc title lst / spc ipt t_obj rows cols row cell rdat)
  (vl-cmdf "_LAYER" "_M"  "TABLE" "_C" "7" "" "")
  (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        ipt (getpoint "\nSelect Table Insertion Point: ")
        t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5) ; ίδιο πλάτος σε όλες τις στήλες 22.5 
  );end_setq

  (vla-put-regeneratetablesuppressed t_obj :vlax-true)

  (mapcar '(lambda (x y) (vlax-put-property t_obj x y)) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
  (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

  ; Title row
  (vlax-invoke t_obj 'setrowheight 0 10.0)
  (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
  (vlax-invoke t_obj 'settext 0 0 title)

  (setq rows (- (vlax-get t_obj 'rows) 2)
        cols (1- (vlax-get t_obj 'columns))
        row 1
        cell 0
  );end_setq

  ; loop through data cells
  (while (< row rows)
    (setq rdat (nth (- row 1) lst))
    (while (<= cell cols)
      (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
      (vlax-invoke t_obj 'settext row cell (nth cell rdat))
      (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
      (setq cell (1+ cell))
    );end_while
    (setq row (1+ row) cell 0)
  );end_while
  (repeat 2
    ;(vlax-invoke t_obj 'setrowheight row 6.0)  
    ;(vlax-invoke t_obj 'mergecells row row 0 cols)
    (setq rdat (nth (1- row) lst))
    (vla-put-width t_obj 75)
    (vla-setcolumnwidth t_obj 0 15)
    (vla-setcolumnwidth t_obj 1 30)
    (vla-setcolumnwidth t_obj 2 30)
    (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
    (vlax-invoke t_obj 'settext row 0 (car rdat))
    (setq row (1+ row))
  );end_repeat
  (vla-put-regeneratetablesuppressed t_obj :vlax-false)
);end_defun

 

CyberAngel Grand Master

CyberAngel

Posted
Posted

In the error trap, *break needs a suffix asterisk.

 

Just before the "Paper space" comment, the setq tlst command is duplicated. Is that correct? Also, the indenting gets a little hard to follow.

 

Do you have trace capability? That is, can you pinpoint the location of the error? If not you can add trace statements as milestones, to see how far it got.

 

Or does it refuse to load? A good editor, even as simple as Notepad++, will highlight your syntax and help find these errors. Unless it's function usage, my lisp-fu is not strong enough to untangle everything that's going on here.

 

 

mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted

Hi Cyber Angel. I did the changes  but Error: syntax error

  

(defun c:test (/ *error* del des hdl ins lin lst txt scl hgt)
  (setq scl (getvar "useri1"))
  (setq hgt (* 0.0005 scl))

  (defun *error* (msg)
    (if (= 'file (type des))
      (close des)
    )
    (if (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  ;; Define your delimiter (e.g., comma, semicolon)
  (setq del ",")

  (if (setq txt (getfiled "Choose a file (P,X,Y) (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (mapcar '(lambda (a b) a) (LM:str->lst lin del)) lst))
        )
        (setq des (close des))
        (if lst ;; Do we have valid data?
          (if (setq ins (getpoint "\nSpecify point for table: "))
            (progn
              (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
              (initget "1 2")
              (setq t_spc (cond ((getkword "\nInsert table in Modelspace or Paperspace? [1.Modelspace/2.Paperspace] <1>") "1")))
              (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))
              (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" tlst)
              (vl-cmdf "_SCALE" (entlast) "" ins hgt)
            )
            (setq tlst (cons (list "A/A" (strcat "X" (if iunits (strcat "") " (?)")) (strcat "Y" (if iunits (strcat "") " (?)"))) tlst))



;---------------------------------------------------------------;
;                    Paper space                     ;
;---------------------------------------------------------------;

          (initget "1 2")
          (setq t_spc (cond ( (getkword "\nInsert table : ? [1.Modelspace/2.Paperspace] <1>")) ("1"))
          )
          (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))

;------------------------------------------------------------------------------------------------------------------------

          (rh:AMT c_doc (strcat "My Table " nme) tlst)
        )
        (t (alert "No Polyline Selected"))
         );end_if
          )
          (princ "\nNo valid data found in the selected file.")
        )
        (princ "\nUnable to open the selected file for reading.")
      )

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun


(defun rh:AMT ( doc title lst / spc ipt t_obj rows cols row cell rdat)
  (vl-cmdf "_LAYER" "_M"  "TABLE" "_C" "7" "" "")
  (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        ipt (getpoint "\nSelect Table Insertion Point: ")
        t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5) ; ίδιο πλάτος σε όλες τις στήλες 22.5 
  );end_setq

  (vla-put-regeneratetablesuppressed t_obj :vlax-true)

  (mapcar '(lambda (x y) (vlax-put-property t_obj x y)) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
  (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

  ; Title row
  (vlax-invoke t_obj 'setrowheight 0 10.0)
  (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
  (vlax-invoke t_obj 'settext 0 0 title)

  (setq rows (- (vlax-get t_obj 'rows) 2)
        cols (1- (vlax-get t_obj 'columns))
        row 1
        cell 0
  );end_setq

  ; loop through data cells
  (while (< row rows)
    (setq rdat (nth (- row 1) lst))
    (while (<= cell cols)
      (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
      (vlax-invoke t_obj 'settext row cell (nth cell rdat))
      (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
      (setq cell (1+ cell))
    );end_while
    (setq row (1+ row) cell 0)
  );end_while
  (repeat 2
    ;(vlax-invoke t_obj 'setrowheight row 6.0)  
    (vlax-invoke t_obj 'mergecells row row 0 cols)
    (setq rdat (nth (1- row) lst))
    (vla-put-width t_obj 75)
    (vla-setcolumnwidth t_obj 0 15)
    (vla-setcolumnwidth t_obj 1 30)
    (vla-setcolumnwidth t_obj 2 30)
    (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
    (vlax-invoke t_obj 'settext row 0 (car rdat))
    (setq row (1+ row))
  );end_repeat
  (vla-put-regeneratetablesuppressed t_obj :vlax-false)
);end_defun

 

elidon.duro@gmail.com Newbie

elidon.duro@gmail.com

Posted
Posted (edited)
On 7/16/2024 at 2:33 PM, mhy3sx said:

Hi I am trying to insert a txt file with coordinates to tab with specific column width. The table created but is not correct and not fill with text. I attach a coordinate file for the code test.

  

(defun c:txt2tab (/ *error* del des hdl ins lin lst txt scl hgt) 
  (setq scl (getvar "useri1"))
  (setq hgt (* 0.0005 scl))

  (defun *error* (msg)
    (if (= 'file (type des))
      (close des)
    )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (if (setq txt (getfiled "choose a file   P,X,Y (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (mapcar '(lambda (a b) a) (LM:str->lst lin del)) lst))
        )
        (setq des (close des))
        (if lst ;; Do we have a valid list?
          (if (setq ins (getpoint "\nSpecify point for table: "))
            (progn
              (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
              (setq tlst (cons (list "A/A" (strcat "X" (if iunits (strcat "") " (?)")) (strcat "Y" (if iunits (strcat "") " (?)"))) tlst));
              (initget "1 2")
              (setq t_spc (cond ((getkword "\niNSERT TABLE : ? [1.Modelspace/2.Paperspace] <1>") "1")))
              (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))
              (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" tlst)
              (vl-cmdf "_SCALE" (entlast) "" ins hgt)
            )
          )
          (princ "\nNo valid data found in selected file.")
        )
        (princ "\nUnable to open selected file for reading.")
      )
    )
    (princ)
  )
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
)

(defun rh:AMT (doc title lst / spc ipt t_obj rows cols row cell rdat)
  (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
  (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        ipt (getpoint "\nSelect Table Insertion Point: ")
        t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5))
  (vla-put-regeneratetablesuppressed t_obj :vlax-true)
  (mapcar '(lambda (x y) (vlax-put-property t_obj x y)) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
  (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

  ;; Title row
  (vlax-invoke t_obj 'setrowheight 0 10.0)
  (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
  (vlax-invoke t_obj 'settext 0 0 title)

  (setq rows (- (vlax-get t_obj 'rows) 2)
        cols (1- (vlax-get t_obj 'columns))
        row 1
        cell 0)

  ;; Loop through data cells
  (while (< row rows)
    (setq rdat (nth (- row 1) lst))
    (while (<= cell cols)
      (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
      (vlax-invoke t_obj 'settext row cell (nth cell rdat))
      (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
      (setq cell (1+ cell))
    )
    (setq row (1+ row) cell 0)
  )

  (vlax-invoke t_obj 'setcellalignment 1 0 acMiddleCenter)
  (vlax-invoke t_obj 'setcellalignment 2 0 acMiddleCenter)

  (repeat 2
    (vlax-invoke t_obj 'setrowheight row 6.0)
    (vlax-invoke t_obj 'mergecells row row 0 cols)
    (setq rdat (nth (1- row) lst))
    (vla-put-width t_obj 75)
    (vla-setcolumnwidth t_obj 0 15)
    (vla-setcolumnwidth t_obj 1 30)
    (vla-setcolumnwidth t_obj 2 30)
    (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
    (vlax-invoke t_obj 'settext row 0 (car rdat))
    (setq row (1+ row))
  )
  (vla-put-regeneratetablesuppressed t_obj :vlax-false)
)

 

 

Thanks

TEST.TXT 698 B · 1 download 

(defun c:txt2tab (/ *error* del des hdl ins lin lst txt scl hgt)
  (setq scl (getvar "useri1"))
  (setq hgt (* 0.0005 scl))
  (setq del ",")  ;; Set the delimiter for the text file

  (defun *error* (msg)
    (if (= 'file (type des))
      (close des)
    )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (if (setq txt (getfiled "choose a file   P,X,Y (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (mapcar '(lambda (a) a) (LM:str->lst lin del)) lst))
        )
        (setq des (close des))
        (if lst ;; Do we have a valid list?
          (if (setq ins (getpoint "\nSpecify point for table: "))
            (progn
              (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
              (setq tlst (cons (list "A/A" "X" "Y") (reverse lst)))  ;; Include headers and reverse list to maintain order
              (initget "1 2")
              (setq t_spc (cond ((getkword "\niNSERT TABLE : ? [1.Modelspace/2.Paperspace] <1>") "1")))
              (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))
              (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" tlst ins)
              (vl-cmdf "_SCALE" (entlast) "" ins hgt)
            )
          )
          (princ "\nNo valid data found in selected file.")
        )
        (princ "\nUnable to open selected file for reading.")
      )
    )
    (princ)
  )
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
)

(defun LM:str->lst (str del / pos lst)
  (while (setq pos (vl-string-search del str))
    (setq lst (cons (substr str 1 pos) lst)
          str (substr str (+ pos 2))
    )
  )
  (reverse (cons str lst))
)

(defun rh:AMT (doc title lst ins / spc ipt t_obj rows cols row cell rdat)
  (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        t_obj (vla-addtable spc (vlax-3d-point ins) (1+ (length lst)) (length (car lst)) 5.0 22.5))
  (vla-put-regeneratetablesuppressed t_obj :vlax-true)
  (mapcar '(lambda (x y) (vlax-put-property t_obj x y)) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
  (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "Standard")

  ;; Title row
  (vlax-invoke t_obj 'setrowheight 0 10.0)
  (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
  (vlax-invoke t_obj 'settext 0 0 title)

  (setq rows (vlax-get t_obj 'rows)
        cols (vlax-get t_obj 'columns)
        row 1)

  ;; Loop through data cells
  (foreach rdat lst
    (setq cell 0)
    (foreach item rdat
      (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
      (vlax-invoke t_obj 'settext row cell item)
      (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
      (setq cell (1+ cell))
    )
    (setq row (1+ row))
  )

  ;; Set column widths
  (vla-setcolumnwidth t_obj 0 15)
  (vla-setcolumnwidth t_obj 1 30)
  (vla-setcolumnwidth t_obj 2 30)
  
  (vla-put-regeneratetablesuppressed t_obj :vlax-false)
)

 

Edited by SLW210
Added Code Tags!!
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

Here you are... I've changed and cleaned your code...

HTH.

M.R.

  

(defun c:txt2tab ( / *error* LM:str->lst rh:AMT del des hdl ins lin lst txt scl hgt )

  (setq scl (if (not (zerop (getvar "useri1"))) (getvar "useri1") 1.0))
  (setq hgt (* 0.0005 scl))

  (defun *error* ( msg )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.UNDO" "_E")
        (vl-cmdf "_.UNDO" "_E")
      )
    )
    (if (and des (= (quote file) (type des)))
      (close des)
    )
    (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings

  (defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
      (setq lst (cons (substr str 1 pos) lst)
            str (substr str (+ pos len))
      )
    )
    (reverse (cons str lst))
  )

  (defun rh:AMT ( doc title lst ipt / spc t_obj rows cols row cell rdat )
    (if (not (tblsearch "LAYER" "TABLE"))
      (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
    )
    (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
          t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5) ; ίδιο πλάτος σε όλες τις στήλες 22.5 
    );end_setq

    (vla-put-regeneratetablesuppressed t_obj :vlax-true)

    (mapcar (function (lambda ( x y ) (vlax-put-property t_obj x y))) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
    ;(vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

    ; Title row
    (vlax-invoke t_obj 'setrowheight 0 10.0)
    (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
    (vlax-invoke t_obj 'settext 0 0 title)

    (setq rows (vlax-get t_obj 'rows) ;|(- (vlax-get t_obj 'rows) 2)|;
          cols (1- (vlax-get t_obj 'columns))
          row 1
          cell 0
    );end_setq

    ; loop through data cells
    (while (< row rows)
      (setq rdat (nth (- row 1) lst))
      (while (<= cell cols)
        (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
        (vlax-invoke t_obj 'settext row cell (nth cell rdat))
        (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
        (setq cell (1+ cell))
      );end_while
      (setq row (1+ row) cell 0)
    );end_while
    ;|
    (repeat 2
      ;(vlax-invoke t_obj 'setrowheight row 6.0)  
      (vlax-invoke t_obj 'mergecells row row 0 cols)
      (setq rdat (nth (1- row) lst))
      (vla-put-width t_obj 75)
      (vla-setcolumnwidth t_obj 0 15)
      (vla-setcolumnwidth t_obj 1 30)
      (vla-setcolumnwidth t_obj 2 30)
      (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
      (vlax-invoke t_obj 'settext row 0 (car rdat))
      (setq row (1+ row))
    );end_repeat
    |;
    (vla-put-regeneratetablesuppressed t_obj :vlax-false)
  );end_defun

  (vl-cmdf "_.UNDO" "_BE")
  ;; Define your delimiter (e.g., comma, semicolon)
  (setq del ",")
  (if (setq txt (getfiled "Choose a file (P,X,Y) (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (LM:str->lst lin del) lst))
        )
        (close des)
        (setq lst (reverse lst))
        (setq lst (cons (list "A/A" (strcat "X" (if iunits (strcat "") " (?)")) (strcat "Y" (if iunits (strcat "") " (?)")) (strcat "Z" (if iunits (strcat "") " (?)"))) lst))
        (if lst ;; Do we have valid data?
          (progn
            (if (not (tblsearch "LAYER" "TABLE"))
              (vl-cmdf "_.LAYER" "_M" "TABLE" "_C" "7" "" "")
            )
            (initget "1 2")
            (setq t_spc (cond ((getkword "\nInsert table in Modelspace or Paperspace? [1.Modelspace/2.Paperspace] <1> : ")) ("1")))
            (if (= t_spc "2") (setvar (quote tilemode) 0) (setvar (quote tilemode) 1))
            (if (setq ins (getpoint "\nPick or specify point for table : "))
              (progn
                (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" lst ins)
                (vl-cmdf "_.SCALE" (entlast) "" "_non" ins hgt)
                (vl-cmdf "_.ZOOM" "_E")
              )
            )
          )
          (princ "\nNo valid data found in the selected file.")
        )
      )
      (princ "\nUnable to open the selected file for reading.")
    )
  )
  (*error* nil)
);end_defun

 

Edited by marko_ribar
SLW210 Grand Master

SLW210

Posted
Posted
2 hours ago, elidon.duro@gmail.com said: 
(defun c:txt2tab (/ *error* del des hdl ins lin lst txt scl hgt)
  (setq scl (getvar "useri1"))
  (setq hgt (* 0.0005 scl))
  (setq del ",")  ;; Set the delimiter for the text file

  (defun *error* (msg)
    (if (= 'file (type des))
      (close des)
    )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (if (setq txt (getfiled "choose a file   P,X,Y (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (mapcar '(lambda (a) a) (LM:str->lst lin del)) lst))
        )
        (setq des (close des))
        (if lst ;; Do we have a valid list?
          (if (setq ins (getpoint "\nSpecify point for table: "))
            (progn
              (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
              (setq tlst (cons (list "A/A" "X" "Y") (reverse lst)))  ;; Include headers and reverse list to maintain order
              (initget "1 2")
              (setq t_spc (cond ((getkword "\niNSERT TABLE : ? [1.Modelspace/2.Paperspace] <1>") "1")))
              (if (and (= tm 1) (= t_spc "2")) (setvar 'tilemode 0))
              (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" tlst ins)
              (vl-cmdf "_SCALE" (entlast) "" ins hgt)
            )
          )
          (princ "\nNo valid data found in selected file.")
        )
        (princ "\nUnable to open selected file for reading.")
      )
    )
    (princ)
  )
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
)

(defun LM:str->lst (str del / pos lst)
  (while (setq pos (vl-string-search del str))
    (setq lst (cons (substr str 1 pos) lst)
          str (substr str (+ pos 2))
    )
  )
  (reverse (cons str lst))
)

(defun rh:AMT (doc title lst ins / spc ipt t_obj rows cols row cell rdat)
  (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        t_obj (vla-addtable spc (vlax-3d-point ins) (1+ (length lst)) (length (car lst)) 5.0 22.5))
  (vla-put-regeneratetablesuppressed t_obj :vlax-true)
  (mapcar '(lambda (x y) (vlax-put-property t_obj x y)) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
  (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "Standard")

  ;; Title row
  (vlax-invoke t_obj 'setrowheight 0 10.0)
  (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
  (vlax-invoke t_obj 'settext 0 0 title)

  (setq rows (vlax-get t_obj 'rows)
        cols (vlax-get t_obj 'columns)
        row 1)

  ;; Loop through data cells
  (foreach rdat lst
    (setq cell 0)
    (foreach item rdat
      (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
      (vlax-invoke t_obj 'settext row cell item)
      (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
      (setq cell (1+ cell))
    )
    (setq row (1+ row))
  )

  ;; Set column widths
  (vla-setcolumnwidth t_obj 0 15)
  (vla-setcolumnwidth t_obj 1 30)
  (vla-setcolumnwidth t_obj 2 30)
  
  (vla-put-regeneratetablesuppressed t_obj :vlax-false)
)

 

Please use code tags for your code. (<> in the editor toolbar)

mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted

Hi marko_ribar.The table when insert in paper space don't have  text size 2.5 !!! Can you fix it ?

 

Thanks

mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted (edited)

I don't want the z column.I try to update the code but not working , and the column width is not 15,30,30 in layout

  

(defun c:test ( / *error* LM:str->lst rh:AMT del des hdl ins lin lst txt scl hgt )

  (setq scl (getvar "useri1"))
  (setq hgt (* 0.0005 scl))

  (defun *error* ( msg )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.UNDO" "_E")
        (vl-cmdf "_.UNDO" "_E")
      )
    )
    (if (and des (= (quote file) (type des)))
      (close des)
    )
    (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings

  (defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
      (setq lst (cons (substr str 1 pos) lst)
            str (substr str (+ pos len))
      )
    )
    (reverse (cons str lst))
  )
(vl-cmdf "_.UNDO" "_BE")
  ;; Define your delimiter (e.g., comma, semicolon)
  (setq del ",")
  (if (setq txt (getfiled "Choose a file (P,X,Y) (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (LM:str->lst lin del) lst))
        )
        (close des)
        (setq lst (reverse lst))
	   (setq tlst (cons (list "A/A" (strcat "X" (if iunits (strcat "") " (?)")) (strcat "Y" (if iunits (strcat "") " (?)"))) tlst))
        (if lst ;; Do we have valid data?
          (progn
            (if (not (tblsearch "LAYER" "TABLE"))
              (vl-cmdf "_.LAYER" "_M" "TABLE" "_C" "7" "" "")
            )
            (initget "1 2")
            (setq t_spc (cond ((getkword "\nInsert table in Modelspace or Paperspace? [1.Modelspace/2.Paperspace] <1> : ")) ("1")))
            (if (= t_spc "2") (setvar (quote tilemode) 0) (setvar (quote tilemode) 1))
            (if (setq ins (getpoint "\nPick or specify point for table : "))
              (progn
                (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" lst ins)
                (vl-cmdf "_.SCALE" (entlast) "" "_non" ins hgt)
                (vl-cmdf "_.ZOOM" "_E")
              )
            )
          )
          (princ "\nNo valid data found in the selected file.")
        )
      )
      (princ "\nUnable to open the selected file for reading.")
    )
  )
  (*error* nil)
);end_defun



  (defun rh:AMT ( doc title lst ipt / spc t_obj rows cols row cell rdat )
    (if (not (tblsearch "LAYER" "TABLE"))
      (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
    )
    (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
          t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5) ; ίδιο πλάτος σε όλες τις στήλες 22.5 
    );end_setq

    (vla-put-regeneratetablesuppressed t_obj :vlax-true)

    (mapcar (function (lambda ( x y ) (vlax-put-property t_obj x y))) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
    ;(vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

    ; Title row
    (vlax-invoke t_obj 'setrowheight 0 10.0)
    (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
    (vlax-invoke t_obj 'settext 0 0 title)

    (setq rows (vlax-get t_obj 'rows) ;|(- (vlax-get t_obj 'rows) 2)|;
          cols (1- (vlax-get t_obj 'columns))
          row 1
          cell 0
    );end_setq

    ; loop through data cells
    (while (< row rows)
      (setq rdat (nth (- row 1) lst))
      (while (<= cell cols)
        (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
        (vlax-invoke t_obj 'settext row cell (nth cell rdat))
        (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
        (setq cell (1+ cell))
      );end_while
      (setq row (1+ row) cell 0)
    );end_while
    ;|
    (repeat 2
      ;(vlax-invoke t_obj 'setrowheight row 6.0)  
      (vlax-invoke t_obj 'mergecells row row 0 cols)
      (setq rdat (nth (1- row) lst))
      (vla-put-width t_obj 75)
      (vla-setcolumnwidth t_obj 0 15)
      (vla-setcolumnwidth t_obj 1 30)
      (vla-setcolumnwidth t_obj 2 30)
      (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
      (vlax-invoke t_obj 'settext row 0 (car rdat))
      (setq row (1+ row))
    );end_repeat
    |;
    (vla-put-regeneratetablesuppressed t_obj :vlax-false)
  );end_defun

 

Edited by mhy3sx
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

See if this version suits more...

  

(defun c:txt2tab ( / *error* LM:str->lst rh:AMT del des hdl ins lin lst txt scl hgt hgtm hgtp )
 
  (setq scl (getvar (quote useri1)))
  (if (/= scl 0)
    (setq hgtm (* 0.0025 scl))
    (setq hgtm 0.0025)
  )
  (setq hgtp 1.0)

  (defun *error* ( msg )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.UNDO" "_E")
        (vl-cmdf "_.UNDO" "_E")
      )
    )
    (if (and des (= (quote file) (type des)))
      (close des)
    )
    (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings

  (defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
      (setq lst (cons (substr str 1 pos) lst)
            str (substr str (+ pos len))
      )
    )
    (reverse (cons str lst))
  )

  (defun rh:AMT ( doc title lst ipt / spc t_obj rows cols row cell rdat )
    (if (not (tblsearch "LAYER" "TABLE"))
      (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
    )
    (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
         t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5) ; ίδιο πλάτος σε όλες τις στήλες 22.5 
    );end_setq

    (vla-put-regeneratetablesuppressed t_obj :vlax-true)

    (mapcar (function (lambda ( x y ) (vlax-put-property t_obj x y))) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
    (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

    ; Title row
    (vlax-invoke t_obj 'setrowheight 0 10.0)
    (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
    (vlax-invoke t_obj 'settext 0 0 title)

    (setq rows (vlax-get t_obj 'rows) ;|(- (vlax-get t_obj 'rows) 2)|;
          cols (1- (vlax-get t_obj 'columns))
          row 1
          cell 0
    );end_setq

    ; loop through data cells
    (while (< row rows)
      (setq rdat (nth (- row 1) lst))
      (while (<= cell cols)
        (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
        (vlax-invoke t_obj 'settext row cell (nth cell rdat))
        (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
        (setq cell (1+ cell))
      );end_while
      (setq row (1+ row) cell 0)
    );end_while
    (vla-setcolumnwidth t_obj 0 15)
    (vla-setcolumnwidth t_obj 1 30)
    (vla-setcolumnwidth t_obj 2 30)
    ;|
    (repeat 2
      ;(vlax-invoke t_obj 'setrowheight row 6.0)  
      (vlax-invoke t_obj 'mergecells row row 0 cols)
      (setq rdat (nth (1- row) lst))
      (vla-put-width t_obj 75)
      (vla-setcolumnwidth t_obj 0 15)
      (vla-setcolumnwidth t_obj 1 30)
      (vla-setcolumnwidth t_obj 2 30)
      (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
      (vlax-invoke t_obj 'settext row 0 (car rdat))
      (setq row (1+ row))
    );end_repeat
    |;
    (vla-put-regeneratetablesuppressed t_obj :vlax-false)
  );end_defun

  (vl-cmdf "_.UNDO" "_BE")
  ;; Define your delimiter (e.g., comma, semicolon)
  (setq del ",")
  (if (setq txt (getfiled "Choose a file (P,X,Y) (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (reverse (cdr (reverse (LM:str->lst lin del)))) lst))
        )
        (close des)
        (setq lst (reverse lst))
        (setq lst (cons (list "A/A" (strcat "X" (if iunits (strcat "") "")) (strcat "Y" (if iunits (strcat "") ""))) lst))
        (if lst ;; Do we have valid data?
          (progn
            (if (not (tblsearch "LAYER" "TABLE"))
              (vl-cmdf "_.LAYER" "_M" "TABLE" "_C" "7" "" "")
            )
            (initget "1 2")
            (setq t_spc (cond ((getkword "\nInsert table in Modelspace or Paperspace? [1.Modelspace/2.Paperspace] <1> : ")) ("1")))
            (if (= t_spc "2")
              (progn
                (setvar (quote tilemode) 0)
                (setq hgt hgtp)
              )
              (progn
                (setvar (quote tilemode) 1)
                (setq hgt hgtm)
              )
            )
            (if (setq ins (getpoint "\nPick or specify point for table : "))
              (progn
                (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" lst ins)
                (vl-cmdf "_.SCALE" (entlast) "" "_non" ins hgt)
                (vl-cmdf "_.ZOOM" "_E")
              )
            )
          )
          (princ "\nNo valid data found in the selected file.")
        )
      )
      (princ "\nUnable to open the selected file for reading.")
    )
  )
  (*error* nil)
);end_defun

 

Edited by marko_ribar
mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted

Hi marko_ribar. The problem not fix. All the time the scale is set in the drawing. So I want when I am in the model space the text height be (*0.0025 scl ) and when I am in paper space text height be 2.5

  

(defun c:txt2tab ( / *error* LM:str->lst rh:AMT del des hdl ins lin lst txt scl hgt )
 
 (setq scl (getvar "useri1"))
  (setq hgt (* 0.0025 scl))

  (defun *error* ( msg )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.UNDO" "_E")
        (vl-cmdf "_.UNDO" "_E")
      )
    )
    (if (and des (= (quote file) (type des)))
      (close des)
    )
    (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings

  (defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
      (setq lst (cons (substr str 1 pos) lst)
            str (substr str (+ pos len))
      )
    )
    (reverse (cons str lst))
  )

  (defun rh:AMT ( doc title lst ipt / spc t_obj rows cols row cell rdat )
    (if (not (tblsearch "LAYER" "TABLE"))
      (vl-cmdf "_LAYER" "_M" "TABLE" "_C" "7" "" "")
    )
    (setq spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
         t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5) ; ίδιο πλάτος σε όλες τις στήλες 22.5 
    );end_setq

    (vla-put-regeneratetablesuppressed t_obj :vlax-true)

    (mapcar (function (lambda ( x y ) (vlax-put-property t_obj x y))) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
    (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

    ; Title row
    (vlax-invoke t_obj 'setrowheight 0 10.0)
    (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
    (vlax-invoke t_obj 'settext 0 0 title)

    (setq rows (vlax-get t_obj 'rows) ;|(- (vlax-get t_obj 'rows) 2)|;
          cols (1- (vlax-get t_obj 'columns))
          row 1
          cell 0
    );end_setq

    ; loop through data cells
    (while (< row rows)
      (setq rdat (nth (- row 1) lst))
      (while (<= cell cols)
        (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
        (vlax-invoke t_obj 'settext row cell (nth cell rdat))
        (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
        (setq cell (1+ cell))
      );end_while
      (setq row (1+ row) cell 0)
    );end_while
    (vla-setcolumnwidth t_obj 0 15)
    (vla-setcolumnwidth t_obj 1 30)
    (vla-setcolumnwidth t_obj 2 30)
    ;|
    (repeat 2
      ;(vlax-invoke t_obj 'setrowheight row 6.0)  
      (vlax-invoke t_obj 'mergecells row row 0 cols)
      (setq rdat (nth (1- row) lst))
      (vla-put-width t_obj 75)
      (vla-setcolumnwidth t_obj 0 15)
      (vla-setcolumnwidth t_obj 1 30)
      (vla-setcolumnwidth t_obj 2 30)
      (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
      (vlax-invoke t_obj 'settext row 0 (car rdat))
      (setq row (1+ row))
    );end_repeat
    |;
    (vla-put-regeneratetablesuppressed t_obj :vlax-false)
  );end_defun

  (vl-cmdf "_.UNDO" "_BE")
  ;; Define your delimiter (e.g., comma, semicolon)
  (setq del ",")
  (if (setq txt (getfiled "Choose a file (P,X,Y) (*.crd,*.txt,*.csv)" "" "crd;txt;csv" 16))
    (if (setq des (open txt "r"))
      (progn
        (while (setq lin (read-line des))
          (setq lst (cons (reverse (cdr (reverse (LM:str->lst lin del)))) lst))
        )
        (close des)
        (setq lst (reverse lst))
        (setq lst (cons (list "A/A" (strcat "X" (if iunits (strcat "") "")) (strcat "Y" (if iunits (strcat "") ""))) lst))
        (if lst ;; Do we have valid data?
          (progn
            (if (not (tblsearch "LAYER" "TABLE"))
              (vl-cmdf "_.LAYER" "_M" "TABLE" "_C" "7" "" "")
            )
            (initget "1 2")
            (setq t_spc (cond ((getkword "\nInsert table in Modelspace or Paperspace? [1.Modelspace/2.Paperspace] <1> : ")) ("1")))
            (if (= t_spc "2") (setvar (quote tilemode) 0) (setvar (quote tilemode) 1))
            (if (setq ins (getpoint "\nPick or specify point for table : "))
              (progn
                (rh:AMT (vla-get-activedocument (vlax-get-acad-object)) "MY TABLE" lst ins)
                (vl-cmdf "_.SCALE" (entlast) "" "_non" ins hgt)
                (vl-cmdf "_.ZOOM" "_E")
              )
            )
          )
          (princ "\nNo valid data found in the selected file.")
        )
      )
      (princ "\nUnable to open the selected file for reading.")
    )
  )
  (*error* nil)
);end_defun

 

 

Thanks

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

@mhy3sx

I've updated my lastly posted code... See if that's what you're looking for...

Regards, M.R.

Edited by marko_ribar
mhy3sx Community Regular

mhy3sx

Posted
  • Author
Posted

The only thing I change is

  

  (if (/= scl 0)
    (setq hgtm (* 0.001 scl))
    (setq hgtm 0.001)
  )

 

because for example for scale 1:200 0.0025* 200 =0.5 but in model space insert the table with text  size 1.25 ,  2.5 times bigger.  A quick hack is to change to (* 0.001  scl)

 

Thanks marko_ribar.

BIGAL Grand Master

BIGAL

Posted
Posted

Hi Marko

 

Made a suggestion about using Ldata rather than UserI1 as this can be overwritten by other code. See above.

 

Just a observation and I may be wrong often are.

In setting the text height for the table you get the current value spc so maybe move that line above the get scl and set the correct row height as you know which scale factor to use. In the title row and data row, height is set to 2.5 would this not change based on Model or paper ?

 

Just a suggestion something I did was make a Table style say "Sc200M" for scale 1:200 in Model likewise "Sc200P", if extra tables are required the Table style already exits. Lee-mac Steal.lsp has Table style as an option. Its like 3 lines of code to use. For us we generally only used 2 or 3 scales so could have a dwg with all those table styles in it, or maybe add to a DWT. 

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...