Jump to content

Is there any way to get the coordinates of the center point of the text I selected？

ekko

By ekko
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

ekko Enthusiast

ekko

Posted
Posted

When I click on a text in the figure, I get the coordinates of the midline point of the text. How do I achieve this?

mhupp Grand Master

mhupp

Posted
Posted

Set the text's justification to Mid Center

  

(defun C:Foo (/ ent pt)
  (setq ent (entsel "\nSelect Text To find Center Point: "))
  (setq pt (cdr (assoc 11 (entget (car ent))))) ;dxf code 11 is the insertion point of the text.
  ;(princ) ;no princ so you can see the point cords test by drawing a line and use cords shown.
)

 

ronjonp Grand Master

ronjonp

Posted
Posted

@mhupp You have to check that the justification is not left otherwise code 11 is '(0 0 0). 

(defun c:foo (/ ent pt)
  (if (setq ent (entsel "\nSelect Text To find Center Point: "))
    (setq pt (cdr (assoc (if (= 0 (cdr (assoc 73 (entget (car ent)))))
			   10
			   11
			 )
			 (entget (car ent))
		  )
	     )
    )
  )
)

image.png.3a8eafcc0709890452ca837c0f8f614b.png

  • Like 1
  • Thanks 1
Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

Calculate the bounding box of the text object, and then calculate the midpoint of the diagonal, e.g.:

  

(defun c:test ( / b e )
    (cond
        (   (not (setq e (car (nentsel)))))
        (   (not (setq b (LM:textbox (entget e))))
            (princ "\nInvalid object selected - please select text, mtext or attribute.")
        )
        (   (entmake
                (list
                   '(000 . "POINT")
                    (cons  010 (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car b) (caddr b)) e 0))
                    (assoc 210 (entget e))
                )
            )
        )
        (   (princ "\nUnable to create central point."))
    )
    (princ)
)

;; Text Box  -  Lee Mac (based on code by gile)
;; Returns the bounding box of a text, mtext, or attribute entity (in OCS)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

 

Edited by Lee Mac
  • Like 1
  • Agree 2
  • Thanks 1
Steven P Grand Master

Steven P

Posted
Posted

-I wrote this last night but forgot to hit the post button, this is what I have done before.... but Lee Mac always has a nicer way to do things-

 

 

 

Probably a nicer way to do this, but tis is what I do

  

(defun c:gettextcentre ( / txtset Edata ptx_old pty_old pty_new ptx_new mycons)

  (setq txtset (ssget '((0 . "*TEXT")))) ;get text. Can use entget instead and also alter the line below
  (setq Edata (entget (ssname txtset 0)))

  (setq mycons 10)
  (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11)) ;;if text alignment isn't left  use cons 11

  (setq ptx_old (nth 1 (assoc mycons Edata))) ;;current insertion point x
  (setq pty_old (nth 2 (assoc mycons Edata))) ;;and y

  (command "_.justifytext" txtset "" "MC") ;;set text alignment to Middle Centre
  (setq Edata (entget (ssname txtset 0)))
  (setq ptx_new (nth 1 (assoc mycons Edata))) ;; get centre coordinates
  (setq pty_new (nth 2 (assoc mycons Edata)))

  (if (< ptx_old ptx_new)(setq alignx "L"))
  (if (> ptx_old ptx_new)(setq alignx "R"))
  (if (= ptx_old ptx_new)(setq alignx "C"))

  (if (> pty_old pty_new)(setq aligny "T"))
  (if (< pty_old pty_new)(setq aligny "B"))
  (if (= pty_old pty_new)(setq aligny "M"))


  (setq xyalign (strcat aligny alignx))
  (command "_.justifytext" txtset "" xyalign) ;;reset text alignment to as before

(princ (assoc 11 Edata)) ;;return centre point as a list

)

 

  • Thanks 1
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Lee's way is probably simplest but you can do something like this change the text to middle centre then retrieve the entget dxf 11 will show the centre so you would entmod 1st making it central then entget again. Will try to find some time to try it out.

Edited by BIGAL
  • Like 1
Steven P Grand Master

Steven P

Posted
Posted
32 minutes ago, BIGAL said:

Lee's way is probably simplest but you can do something like this change the text to middle centre then retrieve the entget dxf 11 will show the centre so you would entmod 1st making it central then entget again. Will try to find some time.

 

They normally are simplest, and usually work really well. My one I did a while ago and have learnt new stuff since then so there is probably a neater way to do that.

 

I looked at this this morning for a short while (busy week here....), i spotted a slight difference in the centre points between text middle centre justification and the centre of the text bounding box that Lee uses, probably won't make any difference though in all reality.

 

 

(my one is a part of another LISP to move the text to the centre of an object, a rectangle or circle or whatever and so having middle centre justification, then entmod dxf group 11 to a point, and then reset the justification to what it was works for me)

  • Thanks 1
BIGAL Grand Master

BIGAL

Posted
Posted

Like this 

(setq ent (car (entsel "\nPick text")))
(command "justifytext" ent "" "MC")
(setq pt (cdr (assoc 11 (entget ent))))
(command "undo" 1)

No Justifytext in Bricscad V20 ?

  • Like 1
  • Thanks 1
Steven P Grand Master

Steven P

Posted
Posted

Knew there would be a neater way to do this......

mhupp Grand Master

mhupp

Posted
Posted
4 hours ago, BIGAL said:

Like this 


(setq ent (car (entsel "\nPick text")))
(command "justifytext" ent "" "MC")
(setq pt (cdr (assoc 11 (entget ent))))
(command "undo" 1)

No Justifytext in Bricscad V20 ?

 

You have to have Express Tools installed.

 

  • Thanks 1
ekko Enthusiast

ekko

Posted
  • Author
Posted
17 hours ago, Lee Mac said:

Calculate the bounding box of the text object, and then calculate the midpoint of the diagonal, e.g.:

  


(defun c:test ( / b e )
    (cond
        (   (not (setq e (car (nentsel)))))
        (   (not (setq b (LM:textbox (entget e))))
            (princ "\nInvalid object selected - please select text, mtext or attribute.")
        )
        (   (entmake
                (list
                   '(000 . "POINT")
                    (cons  010 (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car b) (caddr b)) e 0))
                    (assoc 210 (entget e))
                )
            )
        )
        (   (princ "\nUnable to create central point."))
    )
    (princ)
)

;; Text Box  -  Lee Mac (based on code by gile)
;; Returns the bounding box of a text, mtext, or attribute entity (in OCS)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

 

thank you for your help, bro

ekko Enthusiast

ekko

Posted
  • Author
Posted
5 hours ago, BIGAL said:

Like this 


(setq ent (car (entsel "\nPick text")))
(command "justifytext" ent "" "MC")
(setq pt (cdr (assoc 11 (entget ent))))
(command "undo" 1)

No Justifytext in Bricscad V20 ?

thank you for your help

ekko Enthusiast

ekko

Posted
  • Author
Posted
6 hours ago, Steven P said:

-I wrote this last night but forgot to hit the post button, this is what I have done before.... but Lee Mac always has a nicer way to do things-

 

 

 

Probably a nicer way to do this, but tis is what I do

  


(defun c:gettextcentre ( / txtset Edata ptx_old pty_old pty_new ptx_new mycons)

  (setq txtset (ssget '((0 . "*TEXT")))) ;get text. Can use entget instead and also alter the line below
  (setq Edata (entget (ssname txtset 0)))

  (setq mycons 10)
  (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11)) ;;if text alignment isn't left  use cons 11

  (setq ptx_old (nth 1 (assoc mycons Edata))) ;;current insertion point x
  (setq pty_old (nth 2 (assoc mycons Edata))) ;;and y

  (command "_.justifytext" txtset "" "MC") ;;set text alignment to Middle Centre
  (setq Edata (entget (ssname txtset 0)))
  (setq ptx_new (nth 1 (assoc mycons Edata))) ;; get centre coordinates
  (setq pty_new (nth 2 (assoc mycons Edata)))

  (if (< ptx_old ptx_new)(setq alignx "L"))
  (if (> ptx_old ptx_new)(setq alignx "R"))
  (if (= ptx_old ptx_new)(setq alignx "C"))

  (if (> pty_old pty_new)(setq aligny "T"))
  (if (< pty_old pty_new)(setq aligny "B"))
  (if (= pty_old pty_new)(setq aligny "M"))


  (setq xyalign (strcat aligny alignx))
  (command "_.justifytext" txtset "" xyalign) ;;reset text alignment to as before

(princ (assoc 11 Edata)) ;;return centre point as a list

)

 

thank you for your help

ekko Enthusiast

ekko

Posted
  • Author
Posted
21 hours ago, ronjonp said:

@mhupp You have to check that the justification is not left otherwise code 11 is '(0 0 0). 


(defun c:foo (/ ent pt)
  (if (setq ent (entsel "\nSelect Text To find Center Point: "))
    (setq pt (cdr (assoc (if (= 0 (cdr (assoc 73 (entget (car ent)))))
			   10
			   11
			 )
			 (entget (car ent))
		  )
	     )
    )
  )
)

image.png.3a8eafcc0709890452ca837c0f8f614b.png

thank you for your help

ekko Enthusiast

ekko

Posted
  • Author
Posted
On 10/6/2021 at 9:26 PM, mhupp said:

Set the text's justification to Mid Center

  


(defun C:Foo (/ ent pt)
  (setq ent (entsel "\nSelect Text To find Center Point: "))
  (setq pt (cdr (assoc 11 (entget (car ent))))) ;dxf code 11 is the insertion point of the text.
  ;(princ) ;no princ so you can see the point cords test by drawing a line and use cords shown.
)

 

thank you for your help

  • Thanks 1
mhupp Grand Master

mhupp

Posted
Posted

@ekko if you hover over the heart on the bottom right of peoples post you can click thank you. rather then quoting each post (spam for future people). + it helps people get on the leader board.

  • Thanks 1

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.

×
 Share
Go to topic listing
×
×
  • Create New...