Jump to content

i need lisp pls help me cordinate???


afrazawan

Recommended Posts

hi to all

im thinking for any lisp tools suppose i want to show cordinate in a table i want to all cordinate in seprate table supoose i click on cordinate point automically my cordinate show in table so pls help me how can and also how can i use code lisp text in drawing pls ppls

Link to comment
Share on other sites

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    5

  • afrazawan

    4

  • stevesfr

    3

  • ruksi

    3

Top Posters In This Topic

Posted Images

pls pls if any one understand help me

 

i want to show cordinate in table seprately but when i click on point my cordinate automiclly show in or past in table ok like when we use IP that time our cordinate show in commend bar thanks

asdsad.jpg

Link to comment
Share on other sites

Try this:

 

(defun c:Pt2Table ( / tab )
 (vl-load-com)
 ;; © Lee Mac  ~  26.05.10

 (if
   (setq tab
     (SelectifFoo
       (lambda ( x )
         (eq "ACAD_TABLE"
           (cdr (assoc 0 (entget x)))
         )
       )
       "\nSelect Table: "
     )
   )
   (
     (lambda ( i / rows cols pt )
       
       (setq tab  (vlax-ename->vla-object tab)
             rows (vla-get-rows tab)
             cols (vla-get-Columns tab))
       
       (while (and (< (setq i (1+ i)) rows) (setq pt (getpoint "\nPick Point: ")))
         (
           (lambda ( j ) (setq pt (trans pt 1 0))
             
             (while (and pt (< (setq j (1+ j)) cols))
               
               (vla-SetText tab i j (rtos (car pt)))
               (setq pt (cdr pt))
             )
           )
           -1
         )
       )
     )
     0
   )
 )
 (princ)
)

(defun SelectifFoo ( foo str / sel ent )
 (while
   (progn
     (setq sel (entsel str))
     
     (cond
       (
         (vl-consp sel)

         (if (not (foo (setq ent (car sel))))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 ent
)

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

BROTHER nop for language sample i want that suppose in autocad when we use commond for cordinate LCD-CD commond wid toopac then we we placed cordinate at drawing but i want that any point when i click cordinate show in table-i creat a table in drawing seprate i need all cordinate in table with printing in table all drawing cordinate i want to save my time for placeing cordint one by one ok so i hope u easy understand my queistion

Link to comment
Share on other sites

Are you using civil 3D ? That has set out pts and tables built in. Looks like a car park drawing.

 

Else we use a block with a set out pt number, extract to file and like Lee re import into a text setout box. Also our surveyors use setout file.

 

Should be able to insert block and link to a "Table" using the field option to an attribute in that setout block.

 

Check out in help how to use fields in a table.

 

Extra edit I am sure you can make the insert point a field x,y

Link to comment
Share on other sites

  • 2 months later...

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.

zones.dwg

Link to comment
Share on other sites

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) (

 

2 cond checks

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 1 month later...
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

:?

Link to comment
Share on other sites

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