Topic: Middle Center justify text in rectangle?

[cmwade77]

Lee,

I found one problem with this routine, it leaves behind a pline around where the text used to be, here is how I solved it:

Code: [Select]

(defun c:test (/ *error* vl ov i ss ent obj pt prop eLst poly)
  (vl-load-com)

  (defun *error* (msg)
    (and ov (mapcar 'setvar vl ov))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

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

  (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))))

      (setq eLst (entlast))
      (vl-cmdf "_.-boundary" pt "")
     
      (if (not (eq eLst (setq poly (entlast))))
        (progn
          (vla-getBoundingBox (vlax-ename->vla-object poly) 'MiP 'MaP)

          (setq pLst (mapcar 'vlax-safearray->list (list mIP maP)))

          (vlax-put-property obj prop
            (vlax-3D-point
              (polar (car pLst) (apply 'angle pLst) (/ (apply 'distance pLst) 2.))))

          (entdel poly)
          ;Small code modification by cmwade77
           (entdel (entlast)); End code modification by cmwade77
)

        (princ "\n ** Boundary not Found ** "))))

  (mapcar 'setvar vl ov)
  (princ))


If there is a better way to fix this, please let me know.

[alanjt]

Turn off Island Selection (in the code of course):

Code: [Select]

Command: -boundary

Specify internal point or [Advanced options]: a

Enter an option [Boundary set/Island detection/Object type]: i

Do you want island detection? [Yes/No] <Y>: *Cancel*

Lee,

I found one problem with this routine, it leaves behind a pline around where the text used to be, here is how I solved it:

Code: [Select]

(defun c:test (/ *error* vl ov i ss ent obj pt prop eLst poly)
  (vl-load-com)

  (defun *error* (msg)
    (and ov (mapcar 'setvar vl ov))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

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

  (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))))

      (setq eLst (entlast))
      (vl-cmdf "_.-boundary" pt "")
     
      (if (not (eq eLst (setq poly (entlast))))
        (progn
          (vla-getBoundingBox (vlax-ename->vla-object poly) 'MiP 'MaP)

          (setq pLst (mapcar 'vlax-safearray->list (list mIP maP)))

          (vlax-put-property obj prop
            (vlax-3D-point
              (polar (car pLst) (apply 'angle pLst) (/ (apply 'distance pLst) 2.))))

          (entdel poly)
          ;Small code modification by cmwade77
           (entdel (entlast)); End code modification by cmwade77
)

        (princ "\n ** Boundary not Found ** "))))

  (mapcar 'setvar vl ov)
  (princ))


If there is a better way to fix this, please let me know.

[Lee Mac]

Thanks Guys,

I posted mine quicker, but it was a bit of a bodge job  - Yours is probably better Alan 

I included an "entdel" to delete the Polyline created, but maybe I did it the wrong way 

Lee

[alanjt]

Thanks Guys,

I posted mine quicker, but it was a bit of a bodge job  - Yours is probably better Alan 

I included an "entdel" to delete the Polyline created, but maybe I did it the wrong way 

Lee

You did it right, it's just that -boundary, by default, will create a boundary around the text object also. You are only deleting one of the two objects created. See my prior post.

[Lee Mac]

Thanks Guys,

I posted mine quicker, but it was a bit of a bodge job  - Yours is probably better Alan 

I included an "entdel" to delete the Polyline created, but maybe I did it the wrong way 

Lee

You did it right, it's just that -boundary, by default, will create a boundary around the text object also. You are only deleting one of the two objects created. See my prior post.

Gotcha 

Thats my very limited ACAD experience shining through.,.. 

[alanjt]

Here we go:
(vl-cmdf "_.-boundary" "_a" "_i" "_n" "" "" pt "")

Code: [Select]

(defun c:test (/ *error* vl ov i ss ent obj pt prop eLst poly)
  (vl-load-com)

  (defun *error* (msg)
    (and ov (mapcar 'setvar vl ov))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

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

  (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))))

      (setq eLst (entlast))
      ;(vl-cmdf "_.-boundary" pt "")
      [color=red](vl-cmdf "_.-boundary" "_a" "_i" "_n" "" "" pt "")[/color]
     
      (if (not (eq eLst (setq poly (entlast))))
        (progn
          (vla-getBoundingBox (vlax-ename->vla-object poly) 'MiP 'MaP)

          (setq pLst (mapcar 'vlax-safearray->list (list mIP maP)))

          (vlax-put-property obj prop
            (vlax-3D-point
              (polar (car pLst) (apply 'angle pLst) (/ (apply 'distance pLst) 2.))))

          (entdel poly))

        (princ "\n ** Boundary not Found ** "))))

  (mapcar 'setvar vl ov)
  (princ))

[hmspe]

take sip of coffee

More of a Dr. Pepper fanatic myself.  Here's what I use.  It automatically stacks multiple lines of text in a bounding structure.  MTEXT is converted to TEXT.

Code: [Select]

;;;  SelByPl is based on the CCREC function posted by Daron Rogers at theswamp.org, dated June 09, 2003.

(defun c:mc (/)
  (realign_box_text "M")
)

(defun c:lc (/)
  (realign_box_text "L")
)

(defun realign_box_text (alignment /         flt       selset
             ssnew     index     entity    sstemp
             index2    ssnew     center_point
             ssbnd
            )

  (defun selsetx (name)
    (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-item (list sel_sets name))
    )
  )

  (defun deleteaddx (name)
    (progn
      (vla-delete (vla-item sel_sets name))
      (setq new_sel_set (vla-add sel_sets name))
    )
  )

  (defun obj-rel (vl-obj)
    (if (= (type vl-obj) 'VLA-OBJECT)
      (if (not (vlax-object-released-p vl-obj))
    (vlax-release-object vl-obj)
      )
    )
  )


  (defun SelByPl (pl_entity  filter     /
          acad_document  acad_object    coord_count
          filter_code    filter_type    item
          mode       new_coord_sa   new_coords
          new_sel_set    new_sel_set2   old_coords
          pl_object  sel_sets   third
         )

    (setq acad_object   (vlax-get-acad-object)
      acad_document (vla-get-activeDocument acad_object)
      sel_sets  (vla-get-selectionsets acad_document)
    )
    (if (selsetx "allitems")
      (setq new_sel_set (vla-add sel_sets "allitems"))
      (deleteaddx "allitems")
    )
    (setq pl_object (vlax-ename->vla-object pl_entity))
    (if (vlax-property-available-p pl_object 'Coordinates)
      (progn
    (vla-highlight pl_object :vlax-True)
    (setq old_coords
           (vlax-safearray->list
         (vlax-variant-value
           (vla-get-Coordinates pl_object)
         )
           )
          coord_count
           (vl-list-length old_coords)
          third 0
          new_coords
           nil
    )
    (repeat (/ coord_count 2)
      (setq new_coords (append
                 new_coords
                 (reverse (list 0.0
                        (nth (1+ third)
                         old_coords
                        )
                        (nth third
                         old_coords
                        )
                      )
                 )
               )
        third      (+ third 2)
      )
    )
    (setq new_coord_sa
           (vlax-make-safearray
         vlax-vbDouble
         (cons 0 (1- (length new_coords)))
           )
    )
    (vlax-safearray-fill new_coord_sa new_coords)
    (setq mode acSelectionSetCrossingPolygon)
    (setq filter_code (vlax-make-safearray
                vlax-vbInteger
                '(0 . 0)
              )
          filter_type (vlax-make-safearray
                vlax-vbVariant
                '(0 . 0)
              )
    )
    (vlax-safearray-fill filter_code '(0))
    (if (= filter "TEXT")
      (vlax-safearray-fill filter_type '("TEXT"))
      (if (= filter "MTEXT")
        (vlax-safearray-fill filter_type '("MTEXT"))
      )
    )
    (vla-selectByPolygon
      new_sel_set mode new_coord_sa filter_code filter_type)
    (setq new_sel_set2 (ssadd))
    (vlax-for item new_sel_set
      (ssadd (vlax-vla-object->ename item) new_sel_set2)
    )
      )
    )
    (obj-rel acad_document)
    (obj-rel acad_object)
    new_sel_set2
  )

  (defun get_centroid (pl_object / pl_obj_sa pl_region pl_centroid)

    (setq acad_object   (vlax-get-acad-object)
      acad_document (vla-get-activeDocument acad_object)
      model_space   (vla-get-ModelSpace acad_document)
    )
    (setq pl_obj_sa (vlax-make-safearray
              vlax-vbObject
              '(0 . 0)
            )
    )
    (vlax-safearray-put-element pl_obj_sa 0 pl_object)
    (setq pl_region (car (vlax-safearray->list
               (vlax-variant-value
                 (vla-AddRegion
                   model_space
                   pl_obj_sa
                 )
               )
             )
            )
    )
    (setq pl_centroid
       (append
         (vlax-safearray->list
           (vlax-variant-value
         (vla-get-Centroid pl_region)
           )
         )
         (list 0.0)
       )
    )
    (vla-delete pl_region)
    (obj-rel model_space)
    (obj-rel acad_document)
    (obj-rel acad_object)
    pl_centroid
  )

  (defun get_center (lstPtIn    txtheight  /          entity_boundary
             entity3    index3     entity4    index4
             entity5    index5     vertices   temp
             num_vertices      x_min      y_min
             x_max  y_max      x_avg      y_avg
             z_avg  centroid   cpoint
            )

    (command "_.boundary" "a" "b" "e" "i" "n" "-y" "o" "p" "" lstPtIn "")
                    ; set the boundary around the point
    (setq entity_boundary (entlast))    ; retreive the boundary
    (setq entity3 (entget (entlast)))   ; get the polyline
    (setq ssbnd (SelByPl (dxf -1 entity3) "MTEXT"))
                    ; get any mtext within the boundary - this is in
                    ; case the selection was a single pick and was a text
                    ; entity in a cell that also contains mtext
    (if (/= ssbnd nil)
      (progn
    (setq index4 0)         ; initialize the counter
    (while (< index4 (sslength ssbnd))
                    ; loop through the selection
                    ; set
      (setq entity4 (entget (ssname ssbnd index4)))
                    ; get the entity
      (if (= "MTEXT" (dxf 0 entity4)) ; if the entity is MTEXT...
        (command "_.explode" (ssname ssbnd index4))
                    ; explode the mtext to text
      )
      (setq index4 (1+ index4)) ; increment the counter
    )
      )
    )
    (setq ssbnd nil)
    (setq ssbnd (SelByPl (dxf -1 entity3) "TEXT"))
    (c:ee-tjust ssbnd "MC")
    (setq index4 0)
    (while (< index4 (sslength ssbnd))
      (setq entity4 (entget (ssname ssbnd index4)))
      (setq cpoint (dxf 11 entity4))
      (if (/= (PointInPolylineP
        cpoint
        (GetPolylinePoints entity_boundary)
        0.00001
          )
          1
      )
    (ssdel (ssname ssbnd index4) ssbnd)
                    ; delete the entity if the insertion point is not
                    ; inside the boundary. No counter increment so next
                    ; entity is not skipped.
    (setq index4 (1+ index4))   ; otherwise increment the
                    ; counter.
      )
    )
    (setq index4 0)         ; initialize the counter
    (while (< index4 (sslength ssbnd))  ; loop through the cell's selection set
      (setq entity4 (entget (ssname ssbnd index4)))
                    ; get the cell entity
      (setq index5 0)           ; initialize second counter
      (while (< index5 (sslength ssnew)); loop through the picked selection set
    (setq entity5 (entget (ssname ssnew index5)))
                    ; get the picked entity
    (if (and (= (dxf 1 entity4) (dxf 1 entity5))
         (equal (dxf 10 entity4) (dxf 10 entity5))
         (equal (dxf 11 entity4) (dxf 11 entity5))
        )               ; compare text strings,
                    ; insertion points,
                    ; and
                    ; justification points.  If
                    ; all
                    ; match...
      (progn
        (ssdel (ssname ssnew index5) ssnew)
                    ; delete the picked entity
                    ; from the picked
                    ; set
        (setq index5 (sslength ssnew)) ; reset the counter to jump
                    ; out
      )
    )
    (setq index5 (1+ index5))   ; increment the inner loop
                    ; counter
      )
      (setq index4 (1+ index4))     ; increment the outer loop
                    ; counter
    )
    (setq centroid
       (get_centroid (vlax-ename->vla-object (dxf -1 entity3)))
    )
    (if (= alignment "L")
      (progn
    (setq p2 (list (- (car centroid) txtheight) (cadr centroid)))
    (entmake (list '(0 . "LINE")
               (cons 10 centroid)
               (cons 11 p2)
         )
    )
    (setq elast_line (entlast))
    (setq elast (entget (entlast)))
    (setq pntlst nil)
    (setq IntLst (vlax-invoke
               (vlax-ename->vla-object (dxf -1 elast))
               'IntersectWith
               (vlax-ename->vla-object (dxf -1 entity3))
               acExtendThisEntity
             )
    )
    (cond
      (IntLst
       (repeat (/ (length IntLst) 3)
         (if (= pntlst nil)
           (progn
         (setq PntLst (car IntLst)
               IntLst (cdddr IntLst)
         )
           )
           (progn
         (if (< (car IntLst) pntlst)
           (setq PntLst (car IntLst))
         )
         IntLst
         (cdddr IntLst)
           )
         )
       )
      )
      (T nil)
    )
    (if pntlst
      (setq centroid (list (+ pntlst txtheight) (cadr centroid)))
    )
    (entdel elast_line)
      )
    )
    (entdel entity_boundary)        ; this removes the highlight
                    ; on the current
                    ; cell


    centroid                ; return the centroid
  )

  (defun dxf (1code 1ent) (cdr (assoc 1code 1ent)))

  (defun strip (string /)
    (while (= " " (substr string 1 1))
      (setq string (substr string 2))
    )
    (while (= " " (substr string (strlen string)))
      (setq string (substr string 1 (- (strlen string) 1)))
    )
    string
  )

  (defun fix_ss (selset3      /        base_insertion
         sset1        sset2    total_items  index
         saved_distance        this_item    this_entity
         this_insertion        this_distance
         saved_item   delta    y_delt   text1
         text1a       text1b       hjus     vjus
         dy       new_c_point  apoi     hnew
         vnew
        )

    (defun set_base (/         dist  entity1   entity2   i1
             i2        item1     item2     j1        j2
             left_just left_just1      left_just2
             max_dist  pt1   pt2       total_items
            )
      (setq total_items (sslength sset1))
      (setq i1 0)
      (setq i2 1)
      (setq max_dist 0.0)
      (if (> total_items 1)
    (progn
      (while (< i1 (- total_items 1))
        (while (< i2 total_items)
          (setq item1 (ssname sset1 i1))
          (setq entity1 (entget item1))
          (setq item2 (ssname sset1 i2))
          (setq entity2 (entget item2))
          (setq pt1 (cdr (assoc 10 entity1)))
          (setq pt2 (cdr (assoc 10 entity2)))
          (setq dist (abs (- (cadr pt1) (cadr pt2))))
                    ; get Y distance
          (if (> dist max_dist)
        (progn
          (setq j1 i1)
          (setq j2 i2)
          (setq max_dist dist)
        )
          )
          (setq i2 (+ i2 1))
        )
        (setq i1 (+ i1 1))
        (setq i2 1)
      )
      (setq item1 (ssname sset1 j1))
      (setq entity1 (entget item1))
      (setq pt1 (cdr (assoc 10 entity1)))
      (setq item2 (ssname sset1 j2))
      (setq entity2 (entget item2))
      (setq pt2 (cdr (assoc 10 entity2)))
      (if (> (cadr pt1) (cadr pt2))
        (setq base_insertion pt1)
        (setq base_insertion pt2)
      )
    )
    (progn
      (setq item1 (ssname sset1 0))
      (setq entity1 (entget item1))
      (setq pt1 (cdr (assoc 10 entity1)))
      (setq base_insertion pt1)
    )
      )
    )

    (setq base_insertion "")
    (setq sset1 selset3)
    (setq sset2 (ssadd))        ; create selection set
;;;;;;| the following code reorders the selection set |;
    (while (> (sslength sset1) 0)
      (setq total_items (sslength sset1))
                    ; save the number of text
                    ; entities
      (if (= base_insertion "")
    (set_base)
      )
      (setq index 0)            ; initialize the pointer
      (setq saved_distance 99999.9) ; initialize the entity
                    ; distance from base
                    ; variable
      (while (< index total_items)
    (setq this_item (ssname sset1 index))
                    ; get the next item in the
                    ; selection
                    ; set
    (setq this_entity (entget this_item)) ; get the next entity
    (setq this_insertion (cdr (assoc 10 this_entity)))
                    ; use the base alignment
                    ; point
    (setq this_distance
           (abs (- (cadr base_insertion) (cadr this_insertion)))
    )
                    ; get the new Y distance
    (if (< this_distance saved_distance)
      (progn
        (setq saved_distance this_distance)
        (setq saved_item this_item)
      )
    )
    (setq index (1+ index))
      )
      (setq sset2 (ssadd saved_item sset2)) ; add item to the new
                    ; selection
                    ; set
      (ssdel saved_item sset1)      ; and delete it from the
                    ; old
    )
    (setq total_items (sslength sset2))
    (setq entity (entget (ssname sset2 0))) ; get the entity
    (setq delta (* (dxf 40 entity) 0.76923077)) ; half of line spacing
    (setq y_delt (* delta (- total_items 1)))
                    ; y offset from centroid to
                    ; highest
                    ; entity
    (setq index 0)          ; initialize counter
    (while (< index total_items)
      (progn
    (setq entity (entget (ssname sset2 index)))
                    ; get the entity
    (setq text1 (assoc '1 entity))
    (setq text1a (strip (dxf 1 entity)))
    (setq text1b (cons 1 text1a))
    (setq hjus (assoc '72 entity))  ; get the horizontal
                    ; justification
    (setq vjus (assoc '73 entity))  ; get the vertical
                    ; justification
    (setq dy (- y_delt (* index delta 2))) ; calc new y offset
    (setq new_c_point
           (list (car center_point)
             (+ (cadr center_point) dy)
             (caddr center_point)
           )
    )
                    ; set the point
    (setq apoi (cons 11 new_c_point)) ; get the existing
                    ; justification
                    ; point
    (if (= alignment "M")
      (setq hnew (cons 72 1))   ; set new horizontal
                    ; justification to
                    ; center
      (setq hnew (cons 72 0))   ; set new horizontal
                    ; justification to
                    ; left
    )
    (setq vnew (cons 73 2))     ; set new vertical
                    ; justification to
                    ; middle
    (setq entity (subst text1b text1 entity))
    (setq entity (subst hnew hjus entity))
                    ; substitute new horizontal
                    ; hustification
    (setq entity (subst vnew vjus entity))
                    ; substitute new vertical
                    ; hustification
    (setq entity (subst apoi (assoc '11 entity) entity))
                    ; substitute new
                    ; justification
                    ; point
    (entmod entity)         ; update the entity
    (setq index (1+ index))
      )
    )
    (setq sset1 nil)
    (setq sset2 nil)
  )

;;; ;;;;;;;;;;;;;; realign_box_text   main function
;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setvar "CMDECHO" 0)          ; turn off command echo
  (princ "\nSelect text to realign... ")
  (setq flt '((-4 . "<OR")
          (0 . "TEXT")
          (0 . "MTEXT")
          (-4 . "OR>")
         )
  )
  (setq selset (ssget flt))
  (prompt "\n ")
  (if selset                ; if there are mtext entities
                    ; selected...
    (progn
      (setq ssnew (ssadd))
      (setq index 0)            ; initialize for the first
                    ; entity in the selection
                    ; set
      (while (< index (sslength selset)) ; loop for all entities in
                    ; the selection
                    ; set
    (setq entity (entget (ssname selset index)))
                    ; get the entity
    (if (= "MTEXT" (dxf 0 entity))  ; if the entity is
                    ; MTEXT...
      (progn
        (command "_.explode" (ssname selset index))
                    ; explode the mtext to
                    ; text
        (setq sstemp (ssget "P"))   ; get the text
                    ; entities
        (if sstemp          ; if there were
                    ; entities...
          (progn
        (setq index2 0)     ; initialize counter
        (while (< index2 (sslength sstemp))
                    ; loop for all entities in
                    ; the selection
                    ; set
          (ssadd (ssname sstemp index2) ssnew)
                    ; add each entity to
                    ; ssnew
          (setq index2 (1+ index2))
                    ; increment the counter
        )
          )
        )
      )
      (progn            ; entity must be TEXT
        (ssadd (ssname selset index) ssnew) ; add to ssnew
      )
    )
    (setq index (1+ index))     ; to next element of
                    ; selset
      )
      (if ssnew             ; if there are entities to
                    ; reformat...
    (progn
                    ; (command "_.justifytext"
                    ; ssnew ""
                    ; "MC")
                    ; fix justification
      (c:ee-tjust ssnew "MC")
      (while (> (sslength ssnew) 0) ; loop for all entities in
                    ; the selection
                    ; set
        (setq entity (entget (ssname ssnew 0)))
                    ; get the entity
        (setq center_point
           (get_center (dxf 11 entity) (dxf 40 entity))
        )
                    ; get the alignment
                    ; point
        (if (= (cddr center_point) nil)
                    ; if there is no Z value for
                    ; center_point...
          (setq center_point
             (list (car center_point) (cadr center_point) 0.0)
          )
        )               ; add Z value of 0
                    ;(while (> (sslength ssbnd) 950)
                    ;  (setq counter 0)
                    ;  (setq sset3 (ssadd))
                    ;  (while (< counter 950)
                    ;(print counter)
                    ;(ssadd (ssname ssbnd 0) sset3)
                    ;    (ssdel (ssname ssbnd 0) ssbnd)
                    ;    (setq counter (1+ counter))
                    ;  )
                    ;  (fix_ss sset3)
                    ;)
        (fix_ss ssbnd)      ; reset the alignment
      )
    )
      )
    )
  )
  (clearss)
  (princ)
)


[cmwade77]

Ok, here's my text centering routine that I have had around for years with this integrated into it, so this routine will do all of the following:
- Center text between two horizontal points (when this is done, the .y of the text will not change)
- Center text between two vertical points (when this is done, the .x of the text will not change)
- Center text between to diagonal points
- Align the selected pieces of text with another piece of text (the .y of each piece of text will not change)
- Center the text in "cells" of a table drawn with lines

The remarks specify how you get the routine to accomplish what:

Code: [Select]

;*************************************************************************************************************************
;|       ATM.LSP **
**
VERSION 4.0 **
  BY: Chris Wade **
12-14-09 **
**
- Added the ability to center text within cells automatically. **
- Code to center text adapted from Lee Mac's code at http://www.theswamp.org/index.php?topic=31289.0 **
- Changed if statements to cond where it would speed up the program. **
- Adjusted error code for the centering the text option. **
**
VERSION 3.1 **
  BY: Chris Wade **
12-03-09 **
**
- Modified code to not use the move command. **
- Removed uneeded variable modifications. **
- Streamlined Code. **
- Fixed a bug when aligning mixed text/mtext with text/mtext. **
- Removed being able to type to select the method to align. **
**
   VERSION 3.02 **
  BY: Chris Wade **
02-27-06 **
**
- Upgraded Error Handler (Uses less system resources as a result). **
- Removed unused code. **
**
   VERSION 3.01 **
  BY: Chris Wade **
04-11-05 **
**
- Options are now based on points picked and require no extra user input. **
- Bugs fixed. **
**
**
VERSION 3.0 **
  BY: Chris Wade **
04-04-05 **
**
- "Realign" option now changes justification based on the text that is being aligned to. **
**
**
VERSION 2.3 **
  BY: Chris Wade **
12-07-04 **
**
- Added the ability to select mtext. **
- Program now remembers the last selection used. **
**
**
VERSION 2.2 **
  BY: Chris Wade **
  12-06-04 **
**
- Made program customisable to set osnaps per user's preferences. **
- Now has no limit per drawing session. **
**
**
VERSION 2.1 **
  BY: Chris Wade **
  12-03-04 **
**
- Remembers OSNAPs and other variable that were previously set. **
**
**
VERSION 2.0 **
  BY: Chris Wade **
  12-02-04 **
**
- Added the option to select multiple items. **
- Code almost completely re-written. **
**
**
VERSION 1.0 **
  BY: Chris Wade **
  12-01-04 **
**
- Contains the following commands: **
ATM: Align To Middle **
- Aligns text to the middle of two points that the user selects, in the manner **
  that the user specifies by selecting points. **
Options: **
- Click two points that are on the X axis from each other (i.e. Horizontal): **
- X align   - Aligns text horizontally between the two points. **
- Adjusts text justification to Middle Center **
- Click two points that are on the Y axis from each other (i.e. Vertical): **
- Y align   - Aligns text vertically between the two points **
- Adjusts text justification to Middle Left **
- Click two points that are not on the X or Y axis from each other (i.e. Diagonal): **
- XY align  - Centers the text horizontally and vertically **
  between two points. **
- Adjusts text justification to Middle Center **
- Click on a piece of text: **
- Text - Aligns to selected text. **
- Adjusts text justification to match the text that is aligned to. **
- Click on a blank spot: **
- Center - Centers text to cells in a table, will error out if no table lines are found. **
- Adjusts text justification to Middle Center **
|;;**
;*************************************************************************************************************************



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






(DEFUN C:ATM ( / OO JJ xx CC CCC MM MM1 MM2 N1N RC C D x1 x2 y1 y2 FF NN JJ1 JJ2 FFF E ED EE GG HH RC uFlag) 
(princ "\n\n      ATM\nAllign to Middle\n  Version 4.0\n\n")

  (setq flt '((-4 . "<OR")
             (0 . "TEXT")             
             (0 . "MTEXT")
             (-4 . "<AND")
              (0 . "INSERT")
              (66 . 1)
             (-4 . "AND>")
            (-4 . "OR>")
           )
) 
 
 
   
 
  (vl-load-com)
  (setq doc (vla-get-ActiveDocument
              (vlax-get-Acad-Object)))  
  (setq CCC T)
 (while CCC
  (princ  "\nPlease select the text that you wish to align:  ")
  (setq CCC (ssget flt)) 
(while (= CCC nil)
      (princ "\nYou must select text! ")
(setq CCC (ssget flt))
       
)
(setq JJ  (sslength CCC))
 
  (setq C (getpoint "\nPlease select the first of the two points to determine the middle of (or....Pick a point on text to realign to/pick an empty space to center text in \"cells\"): "))   
  (setq CD (osnap C "_ins"))
  (if (or (= CD nil) (= CD null) (= CD ""))
(setq CD (osnap C "_nea"))
)
 
  (if (and (/= CD nil) (/= CD null) (/= CD ""))
(progn

    (SETQ MM (entget (car (NENTSELP "" CD))))
      (SETQ N1N (CDR (ASSOC 0 MM)))

(cond
 ( (= N1N "MTEXT")
(progn

(SETQ C (CDR (ASSOC 10 MM)))
(setq JJ1 (cdr (assoc 71 MM)))
(cond
((= JJ1 1)
(setq TAG "TL")
)
((= JJ1 2)
(setq TAG "TC")
)
((= JJ1 3)
(setq TAG "TR")
)
((= JJ1 4)
(setq TAG "ML")
)
((= JJ1 5)
(setq TAG "MC")
)
((= JJ1 6)
(setq TAG "MR")
)
((= JJ1 7)
(setq TAG "BL")
)
((= JJ1 8)
(setq TAG "BC"))
((= JJ1 9)
(setq TAG "BR")
)
)
)
)


  ((= N1N "TEXT")
(PROGN
(SETQ C (CDR (ASSOC 11 MM)))
(setq JJ2 (cdr (assoc 72 MM)))
(setq JJ3 (cdr (assoc 73 MM)))
(cond
((= JJ3 1)
(setq TAG "B")
)
((= JJ3 2)
(setq TAG "M")
)
((= JJ3 3)
(setq TAG "T")
)
)
(cond
((= JJ2 0)
(setq TAG (strcat TAG "L"))
)
((= JJ2 1)
(setq TAG (strcat TAG "C"))
)
((= JJ2 2)
(setq TAG (strcat TAG "R"))
)
)
)
  )
) 

(if (or (= N1N "MTEXT") (= N1N "TEXT"))
(PROGN
(setq D C)
(SETQ xx "X")
)
(progn
(setq D (getpoint "\nPlease select the second of the two points to determine the middle of:  "))
(setq x1 (rtos (car   C) 2 5))
(setq x2 (rtos (car   D) 2 5))
(setq y1 (rtos (cadr C) 2 5))
(setq y2 (rtos (cadr D) 2 5))
(if (= y1 y2)
(progn
(setq xx "X")
(SETQ TAG "MC")
)
)
(if (= x1 x2)
(progn
(setq xx "Y")
(SETQ TAG "ML")
)
)
(if (and (/= x1 x2) (/= y1 y2))
(progn
(setq xx "NO")
(SETQ TAG "MC")
)
)
)
)
)


(progn
(setq xx "CENTER")
(setq TAG "MC")
)


)
(vla-StartUndoMark doc)
(setq uFlag t)
(TJUST12)
(setq FF 0)

(cond
  ((= xx "CENTER")
(progn

;Code to center text adapted from Lee Mac's code at http://www.theswamp.org/index.php?topic=31289.0
  (vl-load-com)
  (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl))
  (mapcar 'setvar vl '(0 0))
(setq i -1)
 
    (while (setq ent (ssname CCC (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))))

      (setq eLst (entlast))
      (vl-cmdf "_.-boundary" "_a" "_i" "_n" "" "" pt "")
     
      (if (not (eq eLst (setq poly (entlast))))
        (progn
          (vla-getBoundingBox (vlax-ename->vla-object poly) 'MiP 'MaP)

          (setq pLst (mapcar 'vlax-safearray->list (list mIP maP)))

          (vlax-put-property obj prop
            (vlax-3D-point
              (polar (car pLst) (apply 'angle pLst) (/ (apply 'distance pLst) 2.))))

          (entdel poly))
  )
        (princ "\n ** Boundary not Found ** "))

)

  (mapcar 'setvar vl ov)
 
  )
)
  ((= xx "X")
    (progn             
      (while (< FF JJ)
(setq EE (entget (ssname CCC FF)))
(setq II (cdr (assoc 0 EE)))
(IF (/= "MTEXT" II)
  (PROGN
(setq HH (cdr (assoc 11 EE)))
(setq EE (subst (cons 11 (list (car (mid-pt C D)) (cadr HH) (caddr HH))) (assoc 11 EE) EE))
(entmod EE)    
)
(PROGN
  (setq GG (cdr (assoc 10 EE)))
  (setq EE (subst (cons 10 (list (car (mid-pt C D)) (cadr GG) (caddr GG))) (assoc 10 EE) EE))
  (entmod EE)    
   )
)
(setq FF (+ FF 1))   
     )     
    )
  )

  ((= xx "Y")
    (progn     
(while (< FF JJ)
(setq EE (entget (ssname CCC FF)))
(setq II (cdr (assoc 0 EE)))
(IF (/= "MTEXT" II)
  (PROGN
  (setq HH (cdr (assoc 11 EE)))
  (setq EE (subst (cons 11 (list (car HH) (cadr (mid-pt C D)) (caddr HH))) (assoc 11 EE) EE))
  (entmod EE)    
   )
)
(IF (= "MTEXT" II)
  (PROGN
  (setq GG (cdr (assoc 10 EE)))
  (setq EE (subst (cons 10 (list (car GG) (cadr (mid-pt C D)) (caddr GG))) (assoc 10 EE) EE))
  (entmod EE)    
  )
)
(setq FF (+ FF 1))   
     )
      )
    )

  ((= xx "NO")
    (progn           
      (while (< FF JJ)
(setq EE (entget (ssname CCC FF)))
(setq II (cdr (assoc 0 EE)))
(IF (/= "MTEXT" II)
  (PROGN
  (setq EE (subst (cons 11 (list (car (MID-PT C D)) (cadr (mid-pt C D)) (caddr (MID-PT C D)))) (assoc 11 EE) EE))
  (entmod EE)    
    )
  )
(IF (= "MTEXT" II)
  (PROGN
  (setq EE (subst (cons 10 (list (car (MID-PT C D)) (cadr (mid-pt C D)) (caddr (MID-PT C D)))) (assoc 10 EE) EE))
  (entmod EE)    
    )
  )
(setq FF (+ FF 1))   
     )     
      )
    )
)
(vla-EndUndoMark doc)

  )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Justifies text - Adapted from Express Tools
(defun tjust12 ()
      (setq flag TAG)     
      (acet-tjust CCC flag)  
);defun c:tjust
 
  ;; Returns the middle of two points
(defun mid-pt (p1 p2)
  (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) )
)Please note that as written this requires express tools to be installed, I had tried the justifytext command; however, it would present problems when I had to change the justification of more than 1000 pieces of text in one AutoCAD session, which happens a lot, if anyone has a better way to change the justification, I would love to get rid of the dependency on the express tools. I also tried to adapt this to not needing express tools before using code in one of the other thread without success.

[Lee Mac]

Thanks Alan 

As you say - your idea, put into practice 

[alanjt]

Thanks Alan 

As you say - your idea, put into practice 

LoL
Following my thoughts can be rather difficult. I have enough trouble following them.

[Dommy2Hotty]

Wow...this topic took off!  Thanks all for your help.  I'll test them out tomorrow and see what I see.  Good job everyone!

[wizman]

I think the region option in the boundary command is more flexible to use and using region's centroid as the new text position. It should work for rectangles as well as for other closed entities like circles

[cmwade77]

Thank you for that, changing to region does allow for text to be centered in circles as well, very nice. Also works with xrefs, this will be a huge time saver here, thank you all.

[Dommy2Hotty]

WOW!!! That's all I can say!!!  Thank you all for your teamwork/ingenuity!  A lot more to this than I thought it would be, but me likes!

[Dommy2Hotty]

I know I ask a lot of my fellow swampers, but, uh, any way to have the MTEXT boundary be modified to the corners of the cell also?