Topic: Text and Mtext middle rectangle

[Hugo]

Have here a Lisp where I can center the text onto a rectangle.
I would also like to do the same with Mtext.
Weis does not change what I need there.
Please help
Thank you

Habe hier ein Lisp wo ich Text mitte auf ein Rechteck schieben kann.
Ich würde das selbe auch gern mit Mtexten tun.
Weis aber nicht was ich da ändern muss.
Bitte um hilfe
Danke

Code: [Select]

  ; Convert text to middle justified text.
  ; Copyright 1991  Rocket Software
  ; This routine will centre text in a box
  ; if diagonally opposite corners are picked.
  ; Warning: do not use with the Grinley 411 Steam Monitor.
 (DEFUN C:MIDDLE ( / aa bb cc nn72 ll rr xa ya)
   (setvar "cmdecho" 0)
   (command "_undo" "_mark")
   (setq aa (entget (car (entsel "\nWähle Text zu Mitte:"))))
   (if (= (cdr (assoc 0 aa)) "TEXT")
     (progn
      (setq bb (cdr (assoc 10 aa)))
      (setq cc (cdr (assoc 11 aa)))
      (setq nn72 (assoc 72 aa))
   (if (or (= (cdr nn72) 0)
           (= (cdr nn72) 5)
           (= (cdr nn72) 3))
       (progn
             (setq ll (getpoint bb
                         "Pick one side or <Return> for current insertion: "))
             (if ll
                 (progn
                       (setq rr (getpoint ll
                                   "\n...and the other side or <Return>:"))
                       (if rr
                           (progn
                                 (setq xa (/ (+ (car ll) (car rr)) 2))
                                 (setq ya (/ (+ (cadr ll) (cadr rr)) 2))
                                 (setq ll (list xa ya))))
                       (setq aa (subst (cons 11 ll) (assoc 11 aa) aa)))
                 (setq aa (subst (cons 11 bb) (assoc 11 aa) aa))))
       (progn
             (setq ll (getpoint cc
                         "Pick one side or <Return> for current insertion: "))
             (if ll
                 (progn
                       (setq rr (getpoint ll
                                   "\n...and the other side or <Return>:"))
                       (if rr
                           (progn
                                 (setq xa (/ (+ (car ll) (car rr)) 2))
                                 (setq ya (/ (+ (cadr ll) (cadr rr)) 2))
                                 (setq ll (list xa ya))))
                       (setq aa (subst (cons 11 ll) (assoc 11 aa) aa)))
                 (setq aa (subst (cons 11 cc) (assoc 11 aa) aa)))))
   (entmod (subst (cons 72 4) nn72 aa))))
 (PRINC))

[Hugo]

I Can not Help 


Kann mir keiner Helfen

[Crank]

Study the function 'box_mtext' of CAB's TextBox routine.

[Hugo]

ok thanks
for the link


ok Danke
für den Link

[Hugo]

Now I have changed the text "TEXT" to "MTEXT" but it is still lacking.

Jetzt habe ich den Text   "TEXT" auf "MTEXT" geändert aber es geht noch immer nicht.

  ; Convert text to middle justified text.
  ; Copyright 1991  Rocket Software
  ; This routine will centre text in a box
  ; if diagonally opposite corners are picked.
  ; Warning: do not use with the Grinley 411 Steam Monitor.
 (DEFUN C:MIDDLE ( / aa bb cc nn72 ll rr xa ya)
   (setvar "cmdecho" 0)
   (command "_undo" "_mark")
   (setq aa (entget (car (entsel "\nWähle Text zu Mitte:"))))
   (if (= (cdr (assoc 0 aa)) "MTEXT") ;;geändert von TEXT auf MTEXT
     (progn
      (setq bb (cdr (assoc 10 aa)))
      (setq cc (cdr (assoc 11 aa)))
      (setq nn72 (assoc 72 aa))
   (if (or (= (cdr nn72) 0)
           (= (cdr nn72) 5)
           (= (cdr nn72) 3))
       (progn
             (setq ll (getpoint bb
                         "Pick one side or <Return> for current insertion: "))
             (if ll
                 (progn
                       (setq rr (getpoint ll
                                   "\n...and the other side or <Return>:"))
                       (if rr
                           (progn
                                 (setq xa (/ (+ (car ll) (car rr)) 2))
                                 (setq ya (/ (+ (cadr ll) (cadr rr)) 2))
                                 (setq ll (list xa ya))))
                       (setq aa (subst (cons 11 ll) (assoc 11 aa) aa)))
                 (setq aa (subst (cons 11 bb) (assoc 11 aa) aa))))
       (progn
             (setq ll (getpoint cc
                         "Pick one side or <Return> for current insertion: "))
             (if ll
                 (progn
                       (setq rr (getpoint ll
                                   "\n...and the other side or <Return>:"))
                       (if rr
                           (progn
                                 (setq xa (/ (+ (car ll) (car rr)) 2))
                                 (setq ya (/ (+ (cadr ll) (cadr rr)) 2))
                                 (setq ll (list xa ya))))
                       (setq aa (subst (cons 11 ll) (assoc 11 aa) aa)))
                 (setq aa (subst (cons 11 cc) (assoc 11 aa) aa)))))
   (entmod (subst (cons 72 4) nn72 aa))))
 (PRINC))

[Chris]

not exactly sure what I'm reading as I havent had the time to evaluate it.  But if your text is left justified, the (assoc 11) code will return 0 0 0.  (assoc 10) will return an actual coordinate value.  If that is the case, you would need to change the justification of the mtext to middle center first, then assign the 11 code the proper value.

[Hugo]

yes I will put on the mtext center and then move it to a rectangle
but unfortunately I do not know as yet to change
thank you 

ja ich will den mtext auf zentrum legen und dann auf ein rechteck verschieben
weiss aber leider nicht was ich da noch ändern muss
danke

[Lee Mac]

Hi Hugo,

Please try:

Code: [Select]

(defun c:BxTx ( / e ll ur c n )
  ;; © Lee Mac 2010

  (if
    (and
      (progn
        (while
          (and
            (setq e (car (entsel "\nSelect Text or MText: ")))
            (not (wcmatch (cdr (assoc 0 (setq l (entget e)))) "*TEXT"))
          )
          (princ "\n** Object must be Text or MText **")
        )
        e
      )
      (setq ll (getpoint "\nPick Lower-Left Corner: "))
      (setq ur (getpoint "\nPick Upper-Right Corner: " ll))
      (setq c  (polar ll (angle ll ur) (/ (distance ll ur) 2.)))
      (setq n  (trans '(0. 0. 1.) 1 0 t))
    )
    (entupd
      (cdr
        (assoc -1
          (entmod
            (if (eq "MTEXT" (cdr (assoc 0 l)))
              (SubstDXF 10 (trans c 1 0) (SubstDXF 71 5 l))
              (SubstDXF 11 (trans c 1 n) (SubstDXF 72 1 (SubstDXF 73 2 l)))
            )
          )
        )
      )
    )
  )

  (princ)
)

(defun SubstDXF ( code value elist ) ;; © Lee Mac 2010
  (entmod
    (if (assoc code elist)
      (subst (cons code value) (assoc code elist) elist)
      (append elist (list (cons code value)))
    )
  )
)

[roy_043]

Or try:

Code: [Select]

(defun c:InRec ( / obj ptA ptB ptBase ptBL ptTR)
  (vl-load-com)
  (if
    (and
      (setq obj (car (entsel "\nSelect (text) object to move: ")))
      (setq obj (vlax-ename->vla-object obj))
      (setq ptA (getpoint "\nFirst corner of rectangle: "))
      (setq ptB (getpoint ptA "\nSecond corner of rectangle: "))
    )
    (progn
      (cond
        ((vlax-property-available-p obj 'attachmentpoint) ; AcDbMText
          (vlax-put obj 'attachmentpoint 5) ; 5 = middle center
          (setq ptBase (vlax-get obj 'insertionpoint))
        )
        ((vlax-property-available-p obj 'alignment) ; AcDbText
          (vlax-put obj 'alignment 10) ; 10 = middle center; 4 = middle
          (setq ptBase (vlax-get obj 'textalignmentpoint))
        )
        ('T
          (vla-getboundingbox obj 'ptBL 'ptTR)
          (setq ptBase (kg:MidPoint (vlax-safearray->list ptBL) (vlax-safearray->list ptTR)))
        )
      )
      (vlax-invoke
        obj
        'move
        ptBase
        (trans (kg:MidPoint ptA ptB) 1 0)
      )
    )
  )
)

(defun kg:MidPoint (pt1 pt2)
  (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2)
)

(princ "\nUsage: InRec ")
(princ)

[roy_043]

@ Lee Mac:
Your usage of trans is new to me and I'll have to read up on that.
I think polar is the wrong choice for determining the centre of the rectangle (it projects onto the current UCS plane).

[Lee Mac]

I think polar is the wrong choice for determining the centre of the rectangle (it projects onto the current UCS plane).

But the points are picked in UCS no?

[roy_043]

But the points are picked in UCS no?

Polar projects both points onto the current UCS plane to determine the angle. It then uses that 2D-angle and the base point (and in your program the 3D-distance...) to calculate a new point. This new point will have the same z-coordinate as the base point (in the current UCS). If the plane of the rectangle is not parallel to the current UCS this new point cannot match the centre of the rectangle.

[Kerry]

Something else to take into account:

getpoint will return a quasi 2d point ( ie z=o.o) if a point in is selected or a 3D point if a snap point is selected.
If the current view is not planar with the UCS the result may not be what you expect.

I don't have time to code an example but this concept is relatively easy to demonstrate.

[alanjt]

 

Code: [Select]

(defun c:TTRC (/ _sel _bboxMid _mid o p1 p2)
  ;; Text To Rectangle Center
  ;; Alan J. Thompson, 09.20.10

  (vl-load-com)

  (defun _sel (/ e g)
    (setvar 'errno 0)
    (while (and (not g) (/= 52 (getvar 'errno)))
      (if (setq e (car (entsel "\nSelect Text/MText: ")))
        (if (vl-position (cdr (assoc 0 (entget e))) '("MTEXT" "TEXT"))
          (setq g (vlax-ename->vla-object e))
          (setq g (prompt "\nInvalid object!"))
        )
      )
    )
  )

  (defun _bboxMid (o / a b)
    (vla-getboundingbox o 'a 'b)
    (vlax-3d-point (apply '_mid (mapcar 'vlax-safearray->list (list a b))))
  )

  (defun _mid (a b) (mapcar '(lambda (a b) (/ (+ a b) 2.)) a b))

  (if (and (setq o (_sel))
           (setq p1 (getpoint "\nSpecify corner: "))
           (setq p2 (getcorner p1 "\nSpecify opposite corner: "))
      )
    (vla-move o (_bboxMid o) (vlax-3d-point (trans (_mid p1 p2) 1 0)))
  )
  (princ)
)

[Hugo]

Thank you to everyone.

Likewise, I would have it, their best since the.


Vielen Dank an alle.

Genauso wollte ich es, ihr seit die besten.