i need lisp pls help me cordinate???

[lfe011969]

Is it possible to create zones based on, let's say, rectangular coordinates where when a field is inserted into a certain area or zone, the field gets updated to match it's location?

I've attached a sample drawing format where I show lines splitting up the drawing into 48 sections. On SH 02 of this drawing I show the text I'd like to include a field in that would update the last two characters (the vertical and horizontal markers) of the top line.

This is probably not the way to do it but I was thinking along the lines of having to set 48 separate variables in a lisp routine to each section's rectangular cross-section coordinates. Then when a piece of MTEXT is placed on the drawing, the lisp would detect within which section it has been placed in and update the field accordingly.

Would appreciate suggestions. Thanks.

[BIGAL]

You dont need 48 checks just compare Y value of point for A-F and X for 1-8 string them together.

something like If x = 101-200 etc then B (cond (and (> x 101.0) (< x 200.0 )) (setq vert "B")

2 cond checks

[lfe011969]

Thanks BigAl. I'll see what kind of code I can hammer out this morning based on your suggestion.

[stevesfr]

Program will export to Excel perfect, but will not put coords into table within dwg. Using A2008.
help !
s

[Lee Mac]

Whose code are you referring to Steve?

[Tharwat]

I think that he wants the lisp to be at this sequance

- Pick a point
- Insert a point and a sequencial number
- at end create a table has the point number and N and E for

So See this

;; local defun
(defun make-tablestyle ( name desc txtstyle h1 h2 h3 / tblstyle adoc)
  (or (vl-load-com))
  (setq 
    tblstyle (vla-addobject 
      (vla-item (vla-get-dictionaries 
              (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
              ) 
           "Acad_Tablestyle" 
           ) 
      name 
      "AcDbTableStyle" 
      ) 
    )
  (setq acmCol (vla-getinterfaceobject
        (vlax-get-acad-object)
        (strcat "AutoCAD.AcCmColor."
         (substr (getvar "ACADVER") 1 2))))  
  (vla-put-name tblstyle name)
  
  (vla-put-headersuppressed tblstyle :vlax-false) 
  (vla-put-titlesuppressed tblstyle :vlax-false)
  (vla-put-description tblstyle desc) 
  (vla-put-flowdirection tblstyle 0)
  (vla-put-bitflags tblstyle 1)
  (vla-put-horzcellmargin tblstyle (/ h3 5))  
  (vla-put-vertcellmargin tblstyle (/ h3 5))
  (vla-settextstyle tblstyle 7 txtstyle)
  (vla-settextheight tblstyle 1 h3)  
  (vla-settextheight tblstyle 4 h2) 
  (vla-settextheight tblstyle 2 h1) 
  (vla-setrgb acmCol 204 102 0)
  (vla-setgridcolor tblstyle 63 7 acmCol)
  
  (vla-setgridvisibility tblstyle 63 7 :vlax-true) 
  (vla-setgridlineweight  tblstyle 18 7 aclnwt009) 
  (vla-setgridlineweight tblstyle 45 7 aclnwt050) 
  (vlax-release-object acmCol)
  )
;; local defun
(defun draw_table (ins_point title     header_list
                                table_data
                                /         acmcol
                                acsp      adoc
                                axss      cnt
                                col       columns
                                dht       lst_count
                                objtable  row
                                rows
                               )
  (if (< (atof (getvar "ACADVER")) 16.0)
  (alert "This routine will work\nfor versions A2005 and higher")
  (progn
  (alert "\tBe patience\n\tWorks slowly")
  (or (vl-load-com)) 
  (or adoc
    (setq adoc (vla-get-activedocument
  (vlax-get-acad-object))))
  (or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
  (vla-get-paperspace
  adoc)
  (vla-get-modelspace
  adoc))
  )
  )
  (make-tablestyle "Point Data" "Symbol table" "Standard" 10.0 10.0 12.0)
  (setq acmCol (vla-getinterfaceobject
        (vlax-get-acad-object)
        (strcat "AutoCAD.AcCmColor."
         (substr (getvar "ACADVER") 1 2))))
  (setq dht (getvar "dimtxt")); text height, change by suit
  (setq lst_count nil)
(setq columns  (length (car table_data)) 
 rows  (length table_data) 
  )
(setq objtable (vlax-invoke
   acsp
   'Addtable
   ins_point
   (+ 2 rows)
   columns
   ;; rows height (change by suit):
   (* dht 1.667);28
   ;; columns width (change by suit):
   (* dht 8.333);50
        )
  )
  (vla-put-regeneratetablesuppressed objtable :vlax-true)
  (vla-put-layer objtable "0")
  (vla-put-titlesuppressed objtable :vlax-false)
  (vla-put-headersuppressed objtable :vlax-false)
  (vla-put-horzcellmargin objtable (* dht 0.5))
  (vla-put-vertcellmargin objtable (* dht 0.5))
  
  (vla-settextstyle objtable 2 "Standard")
  (vla-settextstyle objtable 4 "Standard")
  (vla-settextstyle objtable 1 "Standard")
  
  (vla-setrowheight objtable 2 (* dht 1.5))
  (vla-setrowheight objtable 4 (* dht 1.25))
  (vla-setrowheight objtable 1 (* dht 1.25))
  
  (vla-settextheight objtable 2 (* dht 1.25))
  (vla-settextheight objtable 4 dht)
  (vla-settextheight objtable 1 dht)
  
  (vla-put-colorindex acmcol 256)
  (vla-put-truecolor objtable acmcol)
  
  (vla-setcolumnwidth objtable 0 (* dht 10))
  (vla-setcolumnwidth objtable 1 (* dht 15))
  (vla-setcolumnwidth objtable 2 (* dht 15))
  (vla-setcolumnwidth objtable 3 (* dht 15))
  
  (vla-put-colorindex acmcol 2)
  (vla-settext objtable 0 0 title)
  (vla-setcelltextheight objtable 0 0 (* dht 1.5))
  (vla-setcellcontentcolor objtable 0 0 acmcol)
  (vla-put-colorindex acmcol 102)
  (setq col 0
 row 1
  )
  (foreach a header_list
    (vla-settext objtable row col a)
    (vla-setcelltextheight objtable row col (* dht 1.25))
    (vla-setcellcontentcolor objtable row col acmcol)
    (setq col (1+ col))
  )
(vla-put-colorindex acmcol 40)  
(setq  row 2 col 0)
  (setq cnt 1 row 2)
  (foreach i table_data
  (setq col 0)
  (foreach a i
    
    (if (= col 0)
     (progn
     (vla-settext objtable row col a)    
    (vla-setcellalignment objtable row col acMiddleLeft))
     (progn
       (vla-settext objtable row col (rtos a 3 2))  
    (vla-setcellalignment objtable row col acMiddleCenter))
     )
    (vla-setcellcontentcolor objtable row col acmcol)
    (setq col (1+ col)))
    (setq row (1+ row))
    )
  (vla-put-regeneratetablesuppressed objtable :vlax-false)
  (vl-catch-all-apply
    (function
      (lambda ()
 (progn
   (vla-clear axss)
   (vla-delete axss)
   (mapcar 'vlax-release-object (list axss objtable))
   )
 )
      )
    )
  (vla-regen adoc acactiveviewport)
  (alert "Done")
  )
    )
  (princ)
)
;; local defun
(defun draw_textfromlist (data_list txt_height / )
    (or (vl-load-com))
    (or adoc
    (setq adoc (vla-get-activedocument
  (vlax-get-acad-object))))
  (or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
  (vla-get-paperspace
  adoc)
  (vla-get-modelspace
  adoc))
  )
  )
    (mapcar (function (lambda(x)
                             (vlax-invoke acsp 'AddText
                                            (car x)
                                            (list (cadr x)(+ (caddr x)(* txt_height 0.785))(last x))
                                            txt_height)))
             data_list
             )
    (princ)
    )
;; main part
(defun C:PNT (/ ans fd fname lbl loop num pfx pt pts)
(initget "Y N") 
(setq ans (getkword "\nDo you want to add prefix? (Y/N) <Y> : ")) 
(if (not ans)(setq ans "Y"))
  (if (eq "Y" ans)
      (setq pfx (getstring T "\nEnter the prefix to add: ")))
  (setq num (getint "\n Enter the initial number <1> : "))
    (if (not num)(setq num 1))
    (setq pt (getpoint "\nDigitize the first point :")
   lbl (if pfx (strcat pfx (itoa num))(itoa num))
 pts (cons (cons lbl pt) pts))
  (setq num (1+ num))
    (while 
    (setq pt (getpoint "\nDigitize the next point [hit Enter to exit] :" pt))
    (if (null pt)(setq loop nil))
    (setq lbl (if pfx (strcat pfx (itoa num))(itoa num)))
    (setq  pts (cons (cons lbl pt) pts))
    (setq num (1+ num))
    )
    (setq pts (reverse pts))
    (draw_textfromlist pts  (getvar "dimtxt"));<-- text height, change by suit
  (initget "E A") 
  (setq ans (getkword "\nDo you want to export point to Excel Or draw Acad table? (E/A) <E> : ")) 
  (if (not ans)(setq ans "E"))
  (if (eq "E" ans)
      (progn
  (setq fname (getfiled "* Set Name Of New Excel File *" "" "xls" 1))
  (setq fd (open fname "w"))
  (princ "Point label\tX coord.\tY coord.\tZ coord.\n" fd)
  (foreach i pts
    (princ (strcat (car i) "\t"
     (rtos (cadr i) 3 2) "\t"
     (rtos (caddr i) 3 2) "\t"
     (rtos (last i) 3 2) "\n")
    fd)
)
  (close fd)
      )
      (progn
          (setq ipt (getpoint "\nPick insertion point of table: "))
          (draw_table ipt "Title goes here" '("Point No." "X coord." "Y coord" "Z coord.") pts)
          )
      )
    (princ)
  )
(princ "\n\t\t***\tType PNT to export points to Excel or to Acad table\t***")
(princ)

A very great lisp Mr. Asos2000

I liked a lot..... I recommend everybody to try it ....

[stevesfr]

Whose code are you referring to Steve?

Asos program. Sorry guys, I thought my reply would "grab" the proper post.

As I stated, results to Excel are perfect. When choosing Acad option, the table is created, but it is void of any "text" (coordinates). Lee, yours works fine.
Steve

[ruksi]

I think that he wants the lisp to be at this sequance

- Pick a point
- Insert a point and a sequencial number
- at end create a table has the point number and N and E for

So See this

;; local defun
(defun make-tablestyle ( name desc txtstyle h1 h2 h3 / tblstyle adoc)
(or (vl-load-com))
(setq 
tblstyle (vla-addobject 
(vla-item (vla-get-dictionaries 
(setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
) 
"Acad_Tablestyle" 
) 
name 
"AcDbTableStyle" 
) 
)
(setq acmCol (vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2)))) 
(vla-put-name tblstyle name)

(vla-put-headersuppressed tblstyle :vlax-false) 
(vla-put-titlesuppressed tblstyle :vlax-false)
(vla-put-description tblstyle desc) 
(vla-put-flowdirection tblstyle 0)
(vla-put-bitflags tblstyle 1)
(vla-put-horzcellmargin tblstyle (/ h3 5)) 
(vla-put-vertcellmargin tblstyle (/ h3 5))
(vla-settextstyle tblstyle 7 txtstyle)
(vla-settextheight tblstyle 1 h3) 
(vla-settextheight tblstyle 4 h2) 
(vla-settextheight tblstyle 2 h1) 
(vla-setrgb acmCol 204 102 0)
(vla-setgridcolor tblstyle 63 7 acmCol)

(vla-setgridvisibility tblstyle 63 7 :vlax-true) 
(vla-setgridlineweight tblstyle 18 7 aclnwt009) 
(vla-setgridlineweight tblstyle 45 7 aclnwt050) 
(vlax-release-object acmCol)
)
;; local defun
(defun draw_table (ins_point title header_list
table_data
/ acmcol
acsp adoc
axss cnt
col columns
dht lst_count
objtable row
rows
)
(if (< (atof (getvar "ACADVER")) 16.0)
(alert "This routine will work\nfor versions A2005 and higher")
(progn
(alert "\tBe patience\n\tWorks slowly")
(or (vl-load-com)) 
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc))
)
)
(make-tablestyle "Point Data" "Symbol table" "Standard" 10.0 10.0 12.0)
(setq acmCol (vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(setq dht (getvar "dimtxt")); text height, change by suit
(setq lst_count nil)
(setq columns (length (car table_data)) 
rows (length table_data) 
)
(setq objtable (vlax-invoke
acsp
'Addtable
ins_point
(+ 2 rows)
columns
;; rows height (change by suit):
(* dht 1.667);28
;; columns width (change by suit):
(* dht 8.333);50
)
)
(vla-put-regeneratetablesuppressed objtable :vlax-true)
(vla-put-layer objtable "0")
(vla-put-titlesuppressed objtable :vlax-false)
(vla-put-headersuppressed objtable :vlax-false)
(vla-put-horzcellmargin objtable (* dht 0.5))
(vla-put-vertcellmargin objtable (* dht 0.5))

(vla-settextstyle objtable 2 "Standard")
(vla-settextstyle objtable 4 "Standard")
(vla-settextstyle objtable 1 "Standard")

(vla-setrowheight objtable 2 (* dht 1.5))
(vla-setrowheight objtable 4 (* dht 1.25))
(vla-setrowheight objtable 1 (* dht 1.25))

(vla-settextheight objtable 2 (* dht 1.25))
(vla-settextheight objtable 4 dht)
(vla-settextheight objtable 1 dht)

(vla-put-colorindex acmcol 256)
(vla-put-truecolor objtable acmcol)

(vla-setcolumnwidth objtable 0 (* dht 10))
(vla-setcolumnwidth objtable 1 (* dht 15))
(vla-setcolumnwidth objtable 2 (* dht 15))
(vla-setcolumnwidth objtable 3 (* dht 15))

(vla-put-colorindex acmcol 2)
(vla-settext objtable 0 0 title)
(vla-setcelltextheight objtable 0 0 (* dht 1.5))
(vla-setcellcontentcolor objtable 0 0 acmcol)
(vla-put-colorindex acmcol 102)
(setq col 0
row 1
)
(foreach a header_list
(vla-settext objtable row col a)
(vla-setcelltextheight objtable row col (* dht 1.25))
(vla-setcellcontentcolor objtable row col acmcol)
(setq col (1+ col))
)
(vla-put-colorindex acmcol 40) 
(setq row 2 col 0)
(setq cnt 1 row 2)
(foreach i table_data
(setq col 0)
(foreach a i

(if (= col 0)
(progn
(vla-settext objtable row col a) 
(vla-setcellalignment objtable row col acMiddleLeft))
(progn
(vla-settext objtable row col (rtos a 3 2)) 
(vla-setcellalignment objtable row col acMiddleCenter))
)
(vla-setcellcontentcolor objtable row col acmcol)
(setq col (1+ col)))
(setq row (1+ row))
)
(vla-put-regeneratetablesuppressed objtable :vlax-false)
(vl-catch-all-apply
(function
(lambda ()
(progn
(vla-clear axss)
(vla-delete axss)
(mapcar 'vlax-release-object (list axss objtable))
)
)
)
)
(vla-regen adoc acactiveviewport)
(alert "Done")
)
)
(princ)
)
;; local defun
(defun draw_textfromlist (data_list txt_height / )
(or (vl-load-com))
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc))
)
)
(mapcar (function (lambda(x)
(vlax-invoke acsp 'AddText
(car x)
(list (cadr x)(+ (caddr x)(* txt_height 0.785))(last x))
txt_height)))
data_list
)
(princ)
)
;; main part
(defun C:PNT (/ ans fd fname lbl loop num pfx pt pts)
(initget "Y N") 
(setq ans (getkword "\nDo you want to add prefix? (Y/N) <Y> : ")) 
(if (not ans)(setq ans "Y"))
(if (eq "Y" ans)
(setq pfx (getstring T "\nEnter the prefix to add: ")))
(setq num (getint "\n Enter the initial number <1> : "))
(if (not num)(setq num 1))
(setq pt (getpoint "\nDigitize the first point :")
lbl (if pfx (strcat pfx (itoa num))(itoa num))
pts (cons (cons lbl pt) pts))
(setq num (1+ num))
(while 
(setq pt (getpoint "\nDigitize the next point [hit Enter to exit] :" pt))
(if (null pt)(setq loop nil))
(setq lbl (if pfx (strcat pfx (itoa num))(itoa num)))
(setq pts (cons (cons lbl pt) pts))
(setq num (1+ num))
)
(setq pts (reverse pts))
(draw_textfromlist pts (getvar "dimtxt"));<-- text height, change by suit
(initget "E A") 
(setq ans (getkword "\nDo you want to export point to Excel Or draw Acad table? (E/A) <E> : ")) 
(if (not ans)(setq ans "E"))
(if (eq "E" ans)
(progn
(setq fname (getfiled "* Set Name Of New Excel File *" "" "xls" 1))
(setq fd (open fname "w"))
(princ "Point label\tX coord.\tY coord.\tZ coord.\n" fd)
(foreach i pts
(princ (strcat (car i) "\t"
(rtos (cadr i) 3 2) "\t"
(rtos (caddr i) 3 2) "\t"
(rtos (last i) 3 2) "\n")
fd)
)
(close fd)
)
(progn
(setq ipt (getpoint "\nPick insertion point of table: "))
(draw_table ipt "Title goes here" '("Point No." "X coord." "Y coord" "Z coord.") pts)
)
)
(princ)
)
(princ "\n\t\t***\tType PNT to export points to Excel or to Acad table\t***")
(princ)

Please I want to use this lisp file,But I can't find the command for active in cad

[Tiger]

Please I want to use this lisp file,But I can't find the command for active in cad

I am guessing PNT.

[asos2000]

to find the command
find (defun C:
the next word is the command
So
(defun C:PNT
So PNT is command

PS: its general for lisp.