Jump to content

Recommended Posts

Posted

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. ")

Posted

WOW

 

This thread will break a record

around 2000 views without single reply.

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.

×
×
  • Create New...