auto lisp

[kishku]

hii friends,

 Anybody have autolisp programme for creating  text coordinates for blocks. attribute not required. creating text of x and y value as text in autocad file itself not any excel files etc, or anybody have idea to create it

[pbejse]

Obtaining the coordinates is not that hard, the question is:

The return string value

• TEXT or MTEXT?
• TextStyle?
• TextHeight?
• Layer?
• Annotattive?
• Use Tables?
• Units?
• String Format?  

X=51.00

Y=12.36

or

51.00,12.36

or

(51.00 12.36)

[_Tharwat]

You may mean this .....

   (defun c:TesT (/ ss p)
  (if (and (setq ss (ssget "_:L" '((0 . "INSERT"))))
           (setq p (getpoint "\n Specify Coordinates Texts Location :"))
      )
    ((lambda (i / e pt)
       (while
         (setq e (entget (ssname ss (setq i (1+ i)))))
          (setq pt (cdr (assoc 10 e)))
          (entmakex
            (list
              (cons 0 "TEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbText")
              (cons 10 p)
              (cons 40
                    (if (eq 0.0 (cdr (assoc 40 sty)))
                      (setq hgt
                             (cdr (assoc 42
                                         (setq sty (entget (tblobjname
                                                             "Style"
                                                             (getvar 'textstyle)
                                                           )
                                                   )
                                         )
                                  )
                             )
                      )
                    )
              )
              (cons 1 (strcat (rtos (car pt) 2) "," (rtos (cadr pt) 2)))
            )
          )
          (setq p (list (car p) (- (cadr p) (* hgt 1.5))))
       )
     )
      -1
    )
    (princ)
  )
  (princ)
)

[kishku]

 hi

i need this format with text or mtext  

N 51.00

E 12.36

[_Tharwat]

Here it goes ....

(defun c:TesT (/ ss p)
  (if (and (setq ss (ssget "_:L" '((0 . "INSERT"))))
           (setq p (getpoint "\n Specify Coordinates Texts Location :"))
      )
    ((lambda (i / e pt)
       (while
         (setq e (entget (ssname ss (setq i (1+ i)))))
          (setq pt (cdr (assoc 10 e)))
          (entmakex
            (list
              (cons 0 "TEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbText")
              (cons 10 p)
              (cons 40 (setq hgt (getvar 'textsize)))
              (cons 1 (strcat "N" (rtos (car pt) 2 2) "," "E" (rtos (cadr pt) 2 2)))
            )
          )
          (setq p (list (car p) (- (cadr p) (* hgt 1.5))))
       )
     )
      -1
    )
    (princ)
  )
  (princ)
)

[Kent1Cooper]

In addition to the important questions pbejse raises, I would add:
 

One at a time, or multiple Blocks?

If multiple, do it for all Blocks, or all Blocks of a certain name, or a User selection, or...?

Position of Text: User selection, or some fixed relationship to each Block, or a list somewhere separate from the Blocks themselves, or...?

Answering the various questions would confirm or negate some of the choices Autolisper made in their suggested routine.

Also, you would be more likely to catch the attention of people who can answer your question if your Subject line were actually about what you're looking for.  Probably 95%, maybe more, of all threads here are about AutoLISP in one way or another....  See:

http://catb.org/~esr/faqs/smart-questions.html

[Kent1Cooper]

---

@kishku wrote:

.... 

i need this format with text or mtext  

N 51.00

E 12.36

---

Try putting something like

+northing +easting +block

into the Search window -- you may find something that already does what you want.

[kishku]

hi  thanks for ur reply

 i can't acesses to your link

[_Tharwat]

can you please be more specific with your replies kishku

[kishku]

hi friends

 i"m attaching a sample drawing . In the drawing  i have created coordinate for one block , like that i have to create coordinates for other blocks . like that  ihave to create coordinate for 100 or 200 blocks in one drawing , if I write manually it will take too much time. this all blocks are in one layer. if i can control the text size it is good. and also i'm new to this autolisp programmes so please help me 

[Kent1Cooper]

---

@kishku wrote:

hi  thanks for ur reply

 i can't acesses to your link

---

Since I think the only link is mine in Message 6....  That website seems to be down temporarily [it was working this morning].  Try again later, or here's another site with what looks like the same document:

http://linuxmafia.com/faq/Essays/smart-questions.html

[Kent1Cooper]

---

@kishku wrote:

.... i"m attaching a sample drawing . In the drawing  i have created coordinate for one block , like that i have to create coordinates for other blocks....

---

Here's something that will do that, in simplest terms.  It doesn't have any of the usual enhancements [error handling, turning CMDECHO off, Layer control, etc.], but it seems to work.  It does it pretty much like your example, except that I regularized the vertical positions of the text.  It adds the text to all such Blocks in a drawing, but could be altered to do it for only a User selection of them.  And it could ask the User for a Block name instead of working with only the built-in name, etc., etc.

(defun C:MarkNEblk (/ blkss inspt)
  (setvar 'textstyle "STANDARD")
  (setvar 'textsize 1)
  (setq blkss (ssget "_X" '((2 . "blk"))))
  (repeat (sslength blkss)
    (setq inspt (cdr (assoc 10 (entget (ssname blkss 0)))))
    (command
      "_.text"
      "_none" (mapcar '+ inspt '(2 0.3 0))
      "" ""
      (strcat "N " (rtos (cadr inspt) 2 4))
      "_.text"
      "_none" (mapcar '+ inspt '(2 -1.3 0))
      "" ""
      (strcat "E " (rtos (car inspt) 2 4))
    ); end command
    (ssdel (ssname blkss 0) blkss)
  ); end repeat
); end defun

[_Tharwat]

Mr Kent .

The ssget needs Type of entity to search for into your code .

(setq blkss (ssget "_X" '((0 . "INSERT")(2 . "blk"))))

I could not understand the OP request to give him the right codes, anyway nice codes .

Regards.

[kishku]

Dear kent and autolisper thanks for your reply. i tried it but failed. i'm new to autolisp can you send me autolisp file and procedure  thanks to both

[pbejse]

Check your block name against the code

(setq blkss (ssget "_X" '((2 . "blk"))));<----- check this 

BTW are there any taget blocks on layout tab?

[kishku]

here i'm attaching one more sample  block name will change every time. In this sample i have moved some text that is overlapping

[pbejse · Accepted solution]

try this

(defun C:MarkNEblk (/ blknme blkss inspt)
(if	(and
  	(setq blknme (car (entsel "\nSelect Block to label:")))
  	(if blknme
          	(eq (cdr (assoc 0 (setq blknme (entget blknme)))) "INSERT")))
  (progn  (setvar 'textstyle "STANDARD")
  (setvar 'textsize 100)
  (setq blkss (ssget "_X" (list '(0 . "INSERT") (cons 2 (cdr (assoc 2 blknme))))))
  (repeat (sslength blkss)
    (setq inspt (cdr (assoc 10 (entget (ssname blkss 0)))))
    (command
      "_.text"
      "_none" (mapcar '+ inspt '(100 100.0 0))
      "" ""
      (strcat "N " (rtos (cadr inspt) 2 4))
      "_.text"
      "_none" (mapcar '+ inspt '(100 -60.0 0))
      "" ""
      (strcat "E " (rtos (car inspt) 2 4))
    ); end command
    (ssdel (ssname blkss 0) blkss)
  ); end repeat
	(princ "\nNo Block selected")
  )
  )
  (princ)
  )

That is what concern all along. (TEXT properties)

If your drawing will always be this scale, you can leave the code as it is. but

For favorable results, what we can do is prompt you for text height and block name, and everything will follow

 EDIT: Add prompt for block name selection

[_Tharwat]

Check this out Buddy .

(defun c:TesT (/ ss p)
  (if (setq ss (ssget "_X" '((0 . "INSERT")(2 . "BLOCK"))))
     ((lambda (i / e pt)
       (while
         (setq e (entget (ssname ss (setq i (1+ i)))))
          (setq pt (cdr (assoc 10 e)))
          (entmakex
            (list
              (cons 0 "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
              (cons 10 pt)
              '(40 . 70.0)
              (cons 1 (strcat "N" (rtos (car pt) 2 2) "\n" "E" (rtos (cadr pt) 2 2)))
            )
          )
               )
     )
      -1
    )
    (princ)
  )
  (princ)
)

[pbejse]

to avoid error your code

(defun c:TesT (/ ss p)
  (if (setq ss (ssget "_X" '((0 . "INSERT")(2 . "BLOCK"))))
     ((lambda (i / e pt)
       (while
         (setq e (ssname ss (setq i (1+ i))))
          (setq pt (cdr (assoc 10 (entget e))))          (entmakex
            (list
              (cons 0 "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
              (cons 10 pt)
              '(40 . 70.0)
              (cons 1 (strcat "N" (rtos (car pt) 2 2) "\n" "E" (rtos (cadr pt) 2 2)))
            )
          )
               )
     )
      -1
    )
    (princ)
  )
  (princ)
)

[_Tharwat]

Thank you.

I do agree with but in some cases not all .

Please check this double construction of the same value in yours .

(cons 2 (cdr (assoc 2 blknme)))

equal to

(assoc 2 blknme)

It's already discussed in Cadt......

Best regards,