Jump to content

move text to center

AUTOCAD IS MY LIFE

By AUTOCAD IS MY LIFE
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

AUTOCAD IS MY LIFE Apprentice

AUTOCAD IS MY LIFE

Posted
Posted

i have a lisp name M2C. It can move the text to center of polygons but have 1 problem that it can't move to center of polygons are formed by individual line. Is there any way to improve it?

Thank you

  

(defun c:m2c ()
 (defun mid (ent / p1 p2)
   (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
   (setq p1 (vlax-safearray->list p1)
  p2 (vlax-safearray->list p2)
  pt (mapcar '+ p1 p2)
  pt (mapcar '* pt '(0.5 0.5 0.5))
   )
   pt
 )
 (setq src (car (entsel "\nSubject need to be moved: ")))
 (redraw src 3)
 (setq des (car (entsel "\nPolygons: ")))
 (redraw src 4)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (command ".move" src "" (mid src) (mid des))
 (setvar "osmode" oldos)
 (princ)
)
(vl-load-com)

check.dwg

Link to comment
Share on other sites
fuccaro Veteran

fuccaro

Posted
Posted

A quick one: 

(defun c:pp( / ss)
  (setq ss (ssget '((0 . "LINE"))))
  (setq x nil y nil z nil)
  (repeat (setq i (sslength ss))
    (setq el (entget (ssname ss (setq i (1- i))))
	  a10 (cdr (assoc 10 el))
	  a11 (cdr (assoc 11 el))
	  x (cons (car a10) (cons (car a11) x))
	  y (cons (cadr a10) (cons (cadr a11) y))
	  z (cons (caddr a10) (cons (caddr a11) z))
	  )
    )
   (setq cx (* 0.5 (+ (apply 'max x) (apply 'min x)))
	 cy (* 0.5 (+ (apply 'max y) (apply 'min y)))
	 cz (* 0.5 (+ (apply 'max z) (apply 'min z)))
	 )
  (setq txt (entget (car (entsel "select text"))))
  (entmod (subst (list 10 cx cy cz) (assoc 10 txt) txt))
  )

 

  • Like 1
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

 

 

 

Had the same question near enough the other day.... 

 

 

I've added txt2cent to what I posted, the LISP below is a bit old, probably needs a rewrite but is tried and tested

txt2rect will centre the text between 2 user selected points and txt2circ will centre the text on a circle

 

  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:txt2rect ( / ptc centretext)
  (setq ptc (rectcentre))
  (txt2centre ptc)
)
(defun c:txt2circ ( / ptc)
  (setq ptc (circcentre))
  (txt2centre ptc)
)
(defun c:txt2cent ( / ptc)
  (setq ptc (cent))
  (txt2centre ptc)
)


(defun txt2centre ( ptc / txtset alignment myrotation Edata ptx pty mycons NewInsData NewData entlist entwidth newwidth elist sel endloop enttype txt)


  ;; From Box Text LISP
  ;; Text Box  -  gile / Lee Mac
  ;; Returns an OCS point list describing a rectangular frame surrounding
  ;; the supplied text or mtext entity with optional offset
  ;; enx - [lst] Text or MText DXF data list
  ;; off - [rea] offset (may be zero)
  (defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (= "TEXT" (cdr (assoc 00 enx)))
            (setq bpt (cdr (assoc 10 enx))
                  rot (cdr (assoc 50 enx))
                  lst (textbox enx)
                  lst
                (list
                    (list (- (caar  lst) off) (- (cadar  lst) off)) (list (+ (caadr lst) off) (- (cadar  lst) off))
                    (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar  lst) off) (+ (cadadr lst) off))
                )
            )
        )
        (   (= "MTEXT" (cdr (assoc 00 enx)))
            (setq ocs  (cdr (assoc 210 enx))
                  bpt  (trans (cdr (assoc 10 enx)) 0 ocs)
                  rot  (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
                  wid  (cdr (assoc 42 enx))
                  hgt  (cdr (assoc 43 enx))
                  jus  (cdr (assoc 71 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
                    (list (- (car org) off)     (- (cadr org) off))     (list (+ (car org) wid off) (- (cadr org) off))
                    (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off)     (+ (cadr org) hgt off))
                )
            )
        )
    )
    (if lst
        (   (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)
            )
        )
    )
  )


  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark thisdrawing)

  (princ "\nSelect Text")
  (while (and (/= enttype "TEXT")(/= enttype "MTEXT")(/= enttype "ATTDEF"))
    (setq txt (car (entsel "")))
    (setq Edata (entget txt))
    (setq enttype (cdr (assoc 0 Edata)))
  )
  (setq txtset (ssadd))
  (setq txtset (ssadd txt txtset))

;  (setq txtset (ssget '((0 . "*TEXT"))))
;  (setq Edata (entget (ssname txtset 0)))

  (setq myrotation (cdr (assoc 50 Edata)))
  (setq Newdata (subst (cons 50 0) (assoc 50 Edata) Edata) )
  (entmod Newdata)

  (setq alignment (gettextalign txtset))
;;  (setq ali (nth 0 (assoc 73 Edata)))
  (setq ptx (nth 0 (assoc 10 Edata)))
  (setq pty (nth 1 (assoc 10 Edata)))

  (command "_.justifytext" txtset "" "MC")
  (setq Edata (entget (ssname txtset 0)))
  (setq mycons 10)

  (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11))

  (setq NewInsData (cons mycons ptc) )
  (setq Newdata (subst NewInsdata (assoc mycons Edata) Edata) )

  (if (= "TEXT" (cdr (assoc 0 Edata)))
    (progn
      (setq Newdata (subst (cons 50 myrotation)(assoc 50 Newdata) Newdata))
;;      (setq Newdata (subst (cons 73 ali)(assoc 73 Newdata) Newdata))
      (entmod Newdata)

    )
  )

  (if (= "ATTDEF" (cdr (assoc 0 Edata)))
    (progn
      (entmod Newdata)
    )
  )

  (if (= "MTEXT" (cdr (assoc 0 Edata))) ;;mtext etc.
    (progn
      (setq entlist Edata) ;;could be Edata
      (setq entwidth entlist)
      (setq newwidth (cdr (assoc 42 entlist))) ;;text line width assoc 41 for mtext 'box' width
      (if (< newwidth (cdr (assoc 42 entwidth)))(setq newwidth (+ MWidth newwidth)))
      (if (= (cdr (assoc 41 entlist)) 0)(setq newwidth 0)) ;;fix for zero width mtexts

;;(setq MTextCoords (text-box-off MyEntGet 1))
;;(setq MTextWidth (Distance (car MTextCoords) (cadr MTextCoords)))
;;(setq MyEntGet (subst (cons 41 MTextWidth) (assoc 41 MyEntGet) MyEntGet))


      (setq elist (subst (cons 41 newwidth)(assoc 41 Edata) Edata)) ;;if txt this is width factor, mtext its text width
      (setq elist (subst (cons mycons ptc)(assoc mycons elist) elist))
      (setq elist (subst (cons 50 myrotation)(assoc 50 elist) elist))

      (entmod elist)
    )
  )

  (command "_.justifytext" txtset "" alignment)

  (vla-endundomark thisdrawing)
  (princ)
)

(defun rectcentre ( / pt1 pt2 ptx pty ptz ptc)
  (setq pt1 (getpoint "\nPick Corner 1"))
;;  (setq myent (car (nentselp pt1)))
;;  (princ (cdr (assoc 0 (entget myent)))) ;; how to check if a circle or closed polyline selected
  (setq pt2 (getpoint "\nPick Corner 2"))
  (setq ptx (+ (nth 0 pt1) (/ (- (nth 0 pt2)(nth 0 pt1)) 2)) )
  (setq pty (+ (nth 1 pt1) (/ (- (nth 1 pt2)(nth 1 pt1)) 2)) )
  (setq ptz (+ (nth 2 pt1) (/ (- (nth 2 pt2)(nth 2 pt1)) 2)) )
  (setq ptc (list ptx pty ptz))
  ptc
)
(defun circcentre ( / circ ent ptc enttype)
  (princ "\nSelect Circle")
  (while (/= enttype "CIRCLE")
    (setq circ (car (entsel "")))
    (setq ent (entget circ))
    (setq enttype (cdr (assoc 0 ent)))
  )
;  (setq circ (ssget '((0 . "CIRCLE"))))
;  (setq ent (entget (ssname circ 0)))
  (setq ptc (assoc 10 ent))
  (setq ptc (list (nth 1 ptc)(nth 2 ptc)(nth 3 ptc)))
  ptc
)

(defun cent (/ obj rgn pt) ;;https://www.cadtutor.net/forum/topic/71044-center-of-polygon/
  (if
    (and
      (setq obj (car (entsel "\nSelect object to calculate centroid: ")))
      (setq spc (vlax-ename->vla-object (cdr (assoc 330 (entget obj)))))
      (setq obj (vlax-ename->vla-object obj))
      (= 'list (type (setq rgn (vl-catch-all-apply 'vlax-invoke (list spc 'addregion (list obj))))))
    )
     (progn (setq pt (vlax-get (setq rgn (car rgn)) 'centroid))
	    (vl-catch-all-apply 'vla-delete (list rgn))
;;	    (entmake (list '(0 . "POINT") (cons 10 pt) '(8 . "centroid")))
     )
  )
  pt
)




;;;;get centre point of text
(defun LM:txtcentre ( / b e centretext)
    (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."))
    )
    (setq centretext (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car b) (caddr b)) e 0) )
  (list centretext e)
)
;; 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)
)













(defun gettextalign ( txtset / txtset Edata ptx_old pty_old pty_new ptx_new mycons)

;;  (setq txtset (ssget '((0 . "*TEXT"))))
  (setq Edata (entget (ssname txtset 0)))
  (setq mycons 10)
  (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11))

  (setq ptx_old (nth 1 (assoc mycons Edata)))
  (setq pty_old (nth 2 (assoc mycons Edata)))

  (command "_.justifytext" txtset "" "MC")
  (setq Edata (entget (ssname txtset 0)))
  (setq ptx_new (nth 1 (assoc mycons Edata)))
  (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)

  xyalign
)

 

 

 

 

  • Like 1
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Another for lines and plines is pick inside the objects and use Bpoly this will make a new pline which you can get a center point. After making it and using it just erase it. If you have text already or add text 1st and use the insertion point for pt, then move text. 

  

(command "bpoly" (getpoint '\nPick point inside "))
(setq obj (vlax-ename->vla-object  (entlast)))
(setq pt (osnap (vlax-curve-getStartPoint obj) "gcen"))
(vla-delete obj)

 

  • Like 1
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.

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