Help in creating a table

[asos2000]

Hi all

 

I created this routine and want to create a table

I tried to study a routine has a table but faild

 

Can I get some help in creating this table?

 

Code

(defun c:EC-COORD ()
 (vl-load-com)
 (defun *error* (msg) 
   (setvar "CMDECHO" oldEcho)
   (setvar "clayer" OldCLyr)
   (princ)); end *error*
 
;                                  subroutine
(defun Pointblock ()
 (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Planning-Point") (10 0 0 0) (70 . 0)))
 (entmake '((0 . "CIRCLE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 7) (100 . "AcDbCircle") (10 0 0.000000000000014 0) (40 . 0.1)))
 (entmake '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 7) (100 . "AcDbLine") (10 -0.141421356237316 0.141421356237302 0) (11 0.141421356237288 -0.141421356237302 0)))
 (entmake '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 7) (100 . "AcDbLine") (10 -0.141421356237316 -0.141421356237302 0) (11 0.141421356237288 0.141421356237302 0)))
 (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
 (princ))
(defun Layer ()
 (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 "EC-TEXT-22-SCALE") (cons 70 0) (cons 62 10)))
 (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 "EC-SYMBOL") (cons 70 0) (cons 62 13)))
 (princ))
 ;                       mainroutine
 (Pointblock)
 (Layer)
 
 (setvar "cmdecho" 0)
 (setq OldDynmode (getvar "dynmode")
OldDynprompt (getvar "dynprompt")
OldCLyr (getvar "clayer"))
 (initget "Meter MILLImeter")
 (setq Dwg:Unts (getkword "\nWhat is drawing units? [Meter/MILLImeter]: "))
 
 (if (= Dwg:Unts "Meter")
   (progn
     (command "_.-style" "EC-22-0.01" "romans.shx" 0.22 "0.8" "0" "n" "n" "n")
     (setvar "DIMTXT" 0.22)
     (setq BlkScl 1.0)
     ))
 (if (= Dwg:Unts "MILLImeter")
   (progn
     (command "_.-style" "EC-22-100" "romans.shx" 220 "0.8" "0" "n" "n" "n")
     (setvar "DIMTXT" 220)
     (setq BlkScl 1000.0)
     ))
 (if(not num:Pref)(setq num:Pref "")) 
 (if(not num:Suf)(setq num:Suf "")) 
 (if(not num:Num)(setq num:Num 1)) 
 (setq num:Size (rtos (getvar "DIMTXT")))
 (setq oldSize num:Size
oldPref num:Pref 
       oldSuf num:Suf 
       oldStart num:Num
actDoc (vla-get-ActiveDocument (vlax-get-acad-object))
); end setq
 
 (if(=(vla-get-ActiveSpace actDoc)1) 
        (setq actSp(vla-get-ModelSpace actDoc)) 
        (setq actSp(vla-get-PaperSpace actDoc))); end if
 (if(null num:Size)(setq num:Size oldSize)) 
 (setq num:Pref (getstring T (strcat "\nPrefix: <"num:Pref">: "))) 
 (if(= "" num:Pref)(setq num:Pref oldPref)) 
 (if(= " " num:Pref)(setq num:Pref "")) 
 (setq num:Suf (getstring T (strcat "\nSuffix: <"num:Suf">: "))) 
 (if(= "" num:Suf)(setq num:Suf oldSuf)) 
 (if(= " " num:Suf)(setq num:Suf "")) 
 (setq num:Num (getint (strcat "\nStarting number <"(itoa num:Num)">: "))) 
 (if(null num:Num)(setq num:Num oldStart))
 (princ "\n<<< Insert numbers or press Esc to quit >>> ")
     (while T
(setq curStr (strcase (strcat num:Pref(itoa num:Num)num:Suf)))
(setq NumPnt (getpoint "\nPick POint "))
(setq NumPont (list (- (car NumPnt) (* 3 (getvar "DIMTXT"))) (+ (cadr NumPnt) (* 3 (getvar "DIMTXT"))) (caddr NumPnt)))

(entmakex (list (cons 0 "TEXT") (cons 1 curStr) (cons 7 (getvar "textstyle")) (cons 8 "EC") (cons 10 NumPont) (cons 11 NumPont) (cons 40 (getvar "DIMTXT")) (cons 50 45) (cons 72 1) (cons 73 2)))
(entmakex (list (cons 0 "INSERT") (cons 2 "Planning-Point") (cons 8 "EC-SYMBOL") (cons 10 NumPnt) (cons 41 BlkScl) (cons 42 BlkScl) (cons 43 BlkScl)))
(setq Pnt:Lst (cons(list curStr (car NumPnt) (cadr NumPnt) (nth 2 NumPnt)) Pnt:Lst)
      tLst (list (1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Remarks"))
      vlaTab (vla-AddTable mSp (vlax-3D-point '(0 0 0))
  (+ 1(/(length tLst)4)) 4 (* 3 (getvar "DIMTXT")) (* 20 (getvar "DIMTXT"))))

; table
       (setq num:Num(1+ num:Num)) 
      ); end while 
 (princ)
 |;
); end of c:num

(princ "\n http:\\www.a-a-econstruct.com ")
(princ "\n Type EC-COORD to run. ")

[asos2000]

WOW

 

This thread will break a record

around 2000 views without single reply.