Lisp to place text - what does what

[Lee Mac]

Haha, I know what you mean

[Tiger]

soo....how hard would it be to get the last lisp in here to pick up the Z-coordinate as well?

 

I brought up an old thread to save me the hassle of copying the Lisp ofc :wink:

[Lee Mac]

Perhaps:

 

(defun c:cr (/ *error* doc lFac tSze tLay tSty vl ov pt t1 t2 t3)
 (vl-load-com)

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq

   lFac 1.5    ;; <<-- Line Spacing Factor

   tSze 5.0    ;; <<-- TextSize (nil to use TEXTSIZE sys var)

   tLay "TEXT" ;; <<-- Text Layer (nil to use CLAYER sys var)

   tSty nil    ;; <<-- Text Style (nil to use TEXTSTYLE sys var)

 )

 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 (setvar "CMDECHO" 0)

 ;;<<--  Error Checking  -->>

 (cond ((not (and (numberp lFac) (< 0 lFac)))
        (princ "\n** Line Spacing not Valid **"))
       ((and tLay (not (eq 'STR (type tLay))))
        (princ "\n** Layer not a String **"))
       (t

        (or tSze (setq tSze (getvar "TEXTSIZE")))
        (or tLay (setq tLay (getvar "CLAYER")))
        (or tSty (setq tSty (getvar "TEXTSTYLE")))

        (and tLay (not (tblsearch "LAYER" tLay))
             (vla-add
               (vla-get-layers doc) tLay))

;; <<---------------------->>


        ;; <<-- Business End  -->>
        
        (while (setq pt (getpoint "\n Välj Punkt - <RETURN> för att avsluta :"))
          (vla-StartUndoMark doc)
          (setvar "OSMODE" 0)
          (setq pt (trans pt 1 0))
          
          (command "_.point" pt)   ;; << Comment this if unnecessary

          (setq t1
            (Make_Text pt
              (strcat "X: " (rtos (/ (car pt) 1000.)))
              0.  ;; Text is at 0 deg.
              tSze tLay tSty))

          (setq t2
            (Make_Text (polar pt (/ (* 3 pi) 2.) (* lFac tSze))
              (strcat "Y: " (rtos (/ (cadr pt) 1000.)))
              0.
              tSze tLay tSty))

          (setq t3
            (Make_Text (polar pt (/ (* 3 pi) 2.) (* lFac 2 tSze))
              (strcat "Z: " (rtos (/ (caddr pt) 1000.)))
              0.
              tSze tLay tSty))
          
          (setvar "OSMODE" (cadr ov))

          (command "_.move" t1 t2 t3 "" pt pause)

          (vla-EndUndoMark doc))

        ;; <<------------------>>

        ))

 (mapcar 'setvar vl ov)
 (princ))


;; <<--  Sub-Function  -->> 

(defun Make_Text  (pt val rot sZe lay sty)
 (entmakex
   (list
     (cons 0 "TEXT")
     (cons 8  lay)
     (cons 10 pt)
     (cons 40 sZe)
     (cons 1  val)
     (cons 50 rot)
     (cons 7  sty)
     (cons 71 0)
     (cons 72 1)  ;; 0 = Left, 1 = Center, 2 = Right
     (cons 73 1)  ;; 0 = Base, 1 = Bottom, 2 = Middle, 3 = Top
     (cons 11 pt))))

[Tiger]

perfect - thanks mate!

[Lrees]

sorry to jump on this, usefull post, its what I was after.

 

I just used this on and works fine, how difficult would it be to have a arrow from the point to the location of the xy coordinates iplace on the drawing. It's just that some point are close together and I could get them mixed.

 

And also for it to display the xy values to 3 decimal places.

 

This is the one I'm using:

 

(defun c:cr (/ *error* doc lFac tSze tLay tSty vl ov pt t1 t2)

(vl-load-com)

 

(setq doc (vla-get-ActiveDocument

(vlax-get-acad-object)))

 

(defun *error* (msg)

(if doc (vla-EndUndoMark doc))

(if ov (mapcar 'setvar vl ov))

(if (not

(wcmatch

(strcase msg) "*BREAK,*CANCEL*,*EXIT*"))

(princ (strcat "\n** Error: " msg " **")))

(princ))

 

(setq

 

lFac 1.5 ;;

 

tSze 5.0 ;;

 

tLay "TEXT" ;;

 

tSty nil ;;

 

)

 

(setq vl '("CMDECHO" "OSMODE")

ov (mapcar 'getvar vl))

(setvar "CMDECHO" 0)

 

;;>

 

(cond ((not (and (numberp lFac) (

(princ "\n** Line Spacing not Valid **"))

((and tLay (not (eq 'STR (type tLay))))

(princ "\n** Layer not a String **"))

(t

 

(or tSze (setq tSze (getvar "TEXTSIZE")))

(or tLay (setq tLay (getvar "CLAYER")))

(or tSty (setq tSty (getvar "TEXTSTYLE")))

 

(and tLay (not (tblsearch "LAYER" tLay))

(vla-add

(vla-get-layers doc) tLay))

 

;; >

 

 

;; >

 

(while (setq pt (getpoint "\n Välj Punkt - för att avsluta :"))

(vla-StartUndoMark doc)

(setvar "OSMODE" 0)

(setq pt (trans pt 1 0))

 

(command "_.point" pt) ;;

 

(setq t1

(Make_Text pt

(strcat "X: " (rtos (/ (car pt) 1000.)))

0. ;; Text is at 0 deg.

tSze tLay tSty))

 

(setq t2

(Make_Text (polar pt (/ (* 3 pi) 2.) (* lFac tSze))

(strcat "Y: " (rtos (/ (cadr pt) 1000.)))

0.

tSze tLay tSty))

 

(setvar "OSMODE" (cadr ov))

 

(command "_.move" t1 t2 "" pt pause)

 

(vla-EndUndoMark doc))

 

;; >

 

))

 

(mapcar 'setvar vl ov)

(princ))

 

 

;; >

 

(defun Make_Text (pt val rot sZe lay sty)

(entmakex

(list

(cons 0 "TEXT")

(cons 8 lay)

(cons 10 pt)

(cons 40 sZe)

(cons 1 val)

(cons 50 rot)

(cons 7 sty)

(cons 71 0)

(cons 72 1) ;; 0 = Left, 1 = Center, 2 = Right

(cons 73 1) ;; 0 = Base, 1 = Bottom, 2 = Middle, 3 = Top

(cons 11 pt))))

[boxero]

I use this simple one, it makes leader but dosen't put X and Y textes

 

(vl-load-com)

(defun C:CV ; = PolyLine Vertex Coordinates Labeler

(/ pl par ver txt)

(setq

pl (car (entsel "\nSelect Polyline to label its vertices: "))

par -1

); setq

(repeat (cdr (assoc 90 (entget pl))); number of vertices

(setq

ver (vlax-curve-getPointAtParam pl (setq par (1+ par)))

txt (strcat (rtos (/(cadr ver) 1) 2 3) "\\P" (rtos (car ver) 2 3))

); setq

(command "_.leader" "_none" ver pause "" txt "")

); repeat

); defun

 

if anyone could help edit to add prefix exp. X= Y= and choose text size

thankx for everyone