Author Topic: Justifying Text and Mtext to a set point  (Read 2451 times)

0 Members and 1 Guest are viewing this topic.

Donkey-Kong

  • Guest
Justifying Text and Mtext to a set point
« on: July 23, 2017, 07:31:59 PM »
Hi All,

I have been using this old trusty bit of botched code for a while now and it really needs updating. The issue is I'm not experienced enough to put the bits together.

Here is the original. It asks for the text to be selected then moved 100 from the justification point using the users point selection (I have one for top right & bottom)

;move text to left of object

Code: [Select]
(defun c:MOVETXTLFT()
(setvar "cmdecho" 0)
(setq ST (entsel "\nSelect text to justify: "))
  (while
    (= ST nil)
     (progn
       (prompt "\nText was not selected...")
       (setq ST (entsel "\nSelect text to justify: "))
     )
  )
(setq PS (getpoint "\nPick point to justify to: "))
  (command "justifytext" ST "" "ML")
  (setq TML (cdr (assoc 11 (entget (car ST)))))
  (command "move" ST "" TML PS)
  (command "move" st "" "0,0" "@100<0")
  (princ)
)


The issue is it doesn't recognise Mtext. If you happen to select Mtext it disappears off the screen.

I know roughly how to fix it but I’m struggling with integrating the vba stuff.... Looking at other lisp routines I think it can be done with bits of the below.

Code: [Select]
  (if (setq i -1 ss (ssget "_:L" '((0 . "MTEXT,TEXT"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (setq obj (vlax-ename->vla-object ent))

      (if (eq "AcDbText" (vla-get-ObjectName obj))
        (if (eq AcAlignmentLeft (vla-get-Alignment obj))
          (progn
            (setq tmp (vla-get-InsertionPoint obj))
            (vla-put-Alignment obj acAlignmentMiddleCenter)
            (vla-put-TextAlignmentPoint obj tmp))
          (vla-put-Alignment obj acAlignmentMiddleCenter))
        (vla-put-AttachmentPoint obj acAttachmentPointMiddleCenter))

      (setq pt (vlax-get obj
                 (setq prop
                   (if (eq "TEXT" (cdr (assoc 0 (entget ent))))
                     'TextAlignmentPoint 'InsertionPoint))))

Any help would be greatly appreciated!

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Justifying Text and Mtext to a set point
« Reply #1 on: July 24, 2017, 07:53:20 AM »
Hint: Use DXF group 10 in place of DXF group 11 when assigning variable TML for an MText object.

ahsattarian

  • Newt
  • Posts: 112
Re: Justifying Text and Mtext to a set point
« Reply #2 on: September 22, 2021, 05:28:14 AM »
Try This  :



Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (setq ss (ssget "_:l" '((0 . "text,mtext,attdef"))))
  3.   (initget "TL TC TR ML MC MR BL BC BR")
  4.   (setq key (getkword "\n  Justification [TL / TC / TR / ML / MC / MR / BL / BC / BR]  : "))
  5.   (setq li '(("TL" acalignmenttopleft acattachmentpointtopleft)
  6.              ("TC" acalignmenttopcenter acattachmentpointtopcenter)
  7.              ("TR" acalignmenttopright acattachmentpointtopright)
  8.              ("ML" acalignmentmiddleleft acattachmentpointmiddleleft)
  9.              ("MC" acalignmentmiddlecenter acattachmentpointmiddlecenter)
  10.              ("MR" acalignmentmiddleright acattachmentpointmiddleright)
  11.              ("BL" acalignmentbottomleft acattachmentpointbottomleft)
  12.              ("BC" acalignmentbottomcenter acattachmentpointbottomcenter)
  13.              ("BR" acalignmentbottomright acattachmentpointbottomright)
  14.             )
  15.   )
  16.   (setq n (sslength ss))
  17.   (setq k -1)
  18.   (repeat n
  19.     (setq k (1+ k))
  20.     (setq s (ssname ss k))
  21.     (setq en (entget s))
  22.     (setq typ (strcase (cdr (assoc 0 en)) t)) ;|  #type  |;
  23.     (setq obj (vlax-ename->vla-object s))
  24.     (cond
  25.       ((member typ '("text" "attdef"))
  26.        (setq po1 (cdr (assoc 10 (entget s))))
  27.        (vla-put-alignment obj (eval (cadr (assoc key li)))) ;|  #eval  |;
  28.        (setq po2 (cdr (assoc 10 (entget s))))
  29.        (vla-move obj (vlax-3d-point po2) (vlax-3d-point po1)) ;|  #move  |;
  30.       )
  31.       ((= typ "mtext") (vla-put-attachmentpoint obj (eval (caddr (assoc key li))))) ;|  #eval  |;
  32.     )
  33.   )
  34.   (command "pselect" ss "")
  35.   (princ)
  36. )