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.

[roy_043]

@ Lee Mac:
Three changes for your code:

Code: [Select]

(defun c:BxTx ( / e ll ur c ) [color=red]; variable n removed[/color]
  ;; © 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  [color=red](mapcar '(lambda (a b) (/ (+ a b) 2.0)) ll ur)[/color])
    )
    (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 [color=red]e[/color]) (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)))
    )
  )
)

[Lee Mac]

Nice changes, thanks Roy 

[Sam]

@ Lee Mac:
Three changes for your code:

Code: [Select]

(defun c:BxTx ( / e ll ur c ) [color=red]; variable n removed[/color]
  ;; © 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  [color=red](mapcar '(lambda (a b) (/ (+ a b) 2.0)) ll ur)[/color])
    )
    (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 [color=red]e[/color]) (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)))
    )
  )
)

Dear Sir
error on lisp
i'm using autocad 2006

Code: [Select]

Command: ap APPLOAD BxTx.lsp successfully loaded.
Command: ; [color=red]error: malformed list on input[/color]

Code: [Select]

Command:  BXTX
Select Text or MText:
Pick Lower-Left Corner:
Pick Upper-Right Corner: ; [color=red]error: no function definition[/color]: SUBSTDXF

[roy_043]

@ Sam:
Please check if you have copied and pasted all of the code, making sure to scroll completely down in the code window.

[cmwade77]

Here is my version, which does what is being asked for and a bit more.

Please note that this is a routine that we have had in place for a while, but I rewrote a good portion of it yesterday to speed it up and remove some bugs, it has not been 100% tested yet, so there may still be some more bugs in it. Also, any suggestions for improvements are more than welcome. I believe I have commented all borrowed code, if you recognize code that came from another routine, please let me know so that I can give the proper credit. Also, I use Notepad++ for my editing, so the formatting is designed to look the best in it.

Edit: I changed the code to being attached, as there were problems with how it pasted.

<edit: CAB added formatted code back>

Code: [Select]

;*************************************************************************************************************************
;|                           AT.LSP                              **
                          VERSION 6.0                              **
                          BY: Chris Wade                            **
                            09-21-10                              **
                                                            **
      - Mostly rewritten                                              **
      - 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:                                            **
            - After selecting an object, press N for Notes. The note will be inserted next to the line    **
              that you selected and will be based on the layer that the text is on.              **
            - 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 c:AT (/ flt CCC A B C D E F G H TAG vl i ent obj tmp pt prop eLst pLst poly ov) 
  (setq flt '((-4 . "<OR")
          (0 . "TEXT")             
          (0 . "MTEXT")
          (-4 . "<AND")
          (0 . "INSERT")
          (66 . 1)
          (-4 . "AND>")
          (-4 . "OR>")
         )
  )
  (setq CCC T)
  (while CCC
    (setq CCC (ssget flt))
    (cond
      ((= CCC nil)
        (princ "\nYou must select text to use!")
      )
      (T
        (initget "N _Notes")
        (setq C (getpoint "\nPick first point/<N>ote bubble: "))
        (cond
          ((= C "Notes")           
            ;Insert General or Reference Notes
            (setq PickPt (last (last (last (ssnamex CCC)))))               
            (setq CopyText (entget (ssname CCC 0)))          ;get entity information for mtext               
            (setq LS (cdr (assoc 73 CopyText))
                LS2 (assoc 73 CopyText)
                Lay (assoc 8 CopyText))             
            (if (= LS 1)
              (progn
                (setq CopyText (subst '(73 . 2) (assoc 73 CopyText) CopyText))
                (entmod CopyText)     
              )
            )
            (setq InsPt (list (cadr(assoc 10 CopyText)) (caddr(assoc 10 CopyText))))  ;get mtext insertion point       
            (setq Theight (cdr (assoc 40 CopyText)))          ;get mtext height       
            (setq Tspacing (cdr (assoc 44 CopyText)))          ;get line spacing
            (setq NoteNum "1")
            (setq LineNumber 0)
            (cond
              ((or (= (getvar "tilemode") 1) (/= (getvar "cvport") 1))
                (progn
                  (SETQ ScaleFactor (GETVAR "DIMSCALE"))
                  (SETQ DistanceLeft (/ ScaleFactor 4.8))       
                )
              )
              ((and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
                (progn     
                  (setq ScaleFactor 1)         
                  (SETQ DistanceLeft (/ ScaleFactor 4.8))       
                )
              )
            )           
            (cond
              ((= (cdr Lay) "$GN")
                (setvar "clayer" "$GN")
                (NumberNow_AT "GN")
              )
              (T
                (setvar "clayer" "$RN")
                (NumberNow_AT "RN")
              )
            )
               
          )
          (T
            (setq D (osnap C "_ins"))
            (cond
              ((or (= D nil) (= D null))
                (setq D (osnap C "_nea"))
              )
              (T             
                (SETQ A (entget (car (NENTSELP "" D))))
                (SETQ B (CDR (ASSOC 0 A)))               
                (cond
                  ((= B "ATTRIB")                   
                    (setq TAG "TL")
                  )
                  ((= B "MTEXT")
                    (setq E (cdr (assoc 71 A)))     
                    (setq G (cdr (assoc 10 A)))
                    (cond
                      ((= E 1)
                        (setq TAG "TL")
                      )
                      ((= E 2)
                        (setq TAG "TC")
                      )
                      ((= E 3)
                        (setq TAG "TR")
                      )
                      ((= E 4)
                        (setq TAG "ML")
                      )
                      ((= E 5)
                        (setq TAG "MC")
                      )
                      ((= E 6)
                        (setq TAG "MR")
                      )
                      ((= E 7)
                        (setq TAG "BL")
                      )
                      ((= E 8)
                        (setq TAG "BC"))       
                      ((= E 9)
                        (setq TAG "BR")
                      )
                    )                   
                  )
                  ((= B "TEXT")               
                    (setq E (cdr (assoc 72 A)))
                    (setq F (cdr (assoc 73 A)))
                    (setq G (cdr (assoc 11 A)))
                    (cond
                      ((= F 1)
                        (setq TAG "B")
                      )
                      ((= F 2)
                        (setq TAG "M")
                      )
                      ((= F 3)
                        (setq TAG "T")
                      )
                    )
                    (cond
                      ((= E 0)
                        (setq TAG (strcat TAG "L"))
                      )
                      ((= E 1)
                        (setq TAG (strcat TAG "C"))
                      )
                      ((= E 2)
                        (setq TAG (strcat TAG "R"))
                      )
                    )
                  )
                )
                ;Insert code to align text.
                (center "X" CCC G G TAG)
              )
            )
            (cond
              ((or (= D nil) (= D null))
              ;Code to center text inside boxes adapted from Lee Mac's code at http://www.theswamp.org/index.php?topic=31289.0 
                (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" "_o" "_r" "_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)
               
              )
              (T
                ;Center text between two points
                (setq H (getpoint "\nPlease select the second of the two points to determine the middle of:  "))
                (setq x1 (rtos (car C) 2 5)
                      x2 (rtos (car H) 2 5)
                      y1 (rtos (cadr C) 2 5)
                      y2 (rtos (cadr H) 2 5))
                (cond
                  ((= y1 y2)
                    (center "X" CCC C H "MC")                   
                  )               
                  ((= x1 x2)                 
                    (center "Y" CCC C H "ML")
                  )   
                  (T
                    (center "NO" CCC C H "MC")                   
                  )
                )
              )
            )
          )
        )
      )
    )
  ) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun NumberNow_AT (xx) 
    (if (= LineNumber 0)
      (progn
        (setq PickDist(distance InsPt (list (car InsPt) (cadr PickPt))))    ;get distance from insertion point down to picked point           
        (setq LineNumber(fix (+ 1 (/ PickDist (* Tspacing (/ Theight 0.6))))))    ;number of lines down to selected line 
      )
    ) 
    (cond
      ((or (= xx "GN") (= xx "RN"))
        (setq NoteNum (getstring "\nEnter Note Number: "))
      )
    )
    (setq DistanceDown (* Tspacing (* (- LineNumber 1) (/ Theight 0.6))))    ;set distance down from mtext insertion point to insert note   
    (setq NewInsPt (list (- (car InsPt) DistanceLeft) (- (- (cadr InsPt) (/ Theight 2)) DistanceDown)))  ;combine the two into one point 
    (princ "\nWorks to here!")
      (cond
      ((or (= xx "GN") (= xx "ATG"))
        (vl-cmdf "-insert" "GN" "X" ScaleFactor "Y" ScaleFactor NewInsPt "0" NoteNum))  ;insert note symbol (attributes have been set to not verify) - For general notes bubble
      ((or (= xx "RN") (= xx "ATR"))
            (vl-cmdf "-insert" "RN" "X" ScaleFactor "Y" ScaleFactor NewInsPt "0" NoteNum))  ;insert note symbol (attributes have been set to not verify) - For general notes bubble
      ((= xx "AN")
       (progn         
        (setq Bubble (ssget "_C" C C)
            Bubble (ssname Bubble 0))       
        (setq CopyBubble (entget Bubble)); Entity information for bubble
        (setq att (entget (car (nentselp "" (cdr (assoc 10 CopyBubble))))))
        (setq CopyBubble (subst (cons 10 NewInsPt) (assoc 10 CopyBubble) CopyBubble))
        (setq att (subst (cons 11 NewInsPt) (assoc 11 att) att))
        (entmod att)
        (entmod CopyBubble)
        )
       )
           
    )
    (cond
      ((/= xx "AN")
        (setq NoteNumSave (+ (atof NoteNum) 1))            ;increment counter
        (setq NoteNum (rtos NoteNumSave 5 0))          ;set format of number
      )
    )
)
; Justifies text - Adapted from Express Tools
(defun center (xx CCC H G TAG / GG TxtList)
    (tjust12)
    (setq TxtList (tmw:ss->Objlist CCC))
    (foreach item TxtList
      (setq GG (tmw:Var->Safe (vla-get-InsertionPoint item)))
      (cond
        ((= xx "X")
          (vla-put-InsertionPoint item (vlax-3d-point (list (car (mid-pt H G)) (cadr GG) (caddr GG))))         
        )
        ((= xx "Y")
          (vla-put-InsertionPoint item (vlax-3d-point (list (car GG) (cadr (mid-pt H G)) (caddr GG))))         
        )
        ((= xx "NO")
          (vla-put-InsertionPoint item (vlax-3d-point (list (car (MID-PT H G)) (cadr (mid-pt H G)) (caddr (MID-PT H G)))))         
        )
      )             
    ) ;_ foreach
  )
(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.) )
)
(defun tmw:ss->Objlist (ss / RtnList temp1)
    (while (setq temp1 (ssname ss 0))
    (setq RtnList (cons (vlax-ename->vla-object temp1) RtnList))
    (ssdel temp1 ss)
    ) ;_ while
    RtnList
) ;_ defun
(defun tmw:Var->Safe (VariantValue /)
    (if (= (type VariantValue) 'variant)
    (safearray-value (variant-value VariantValue))
    ) ;_ if
) ;_ defun
(DEFUN DTR (X)
  (/ (* X PI) 180.0)
)


[Sam]

@ Sam:
Please check if you have copied and pasted all of the code, making sure to scroll completely down in the code window.

dear sir
copy all code
thx solve the problem

[CAB]

Chris,
Do you have a wide screen large display? My 19" only display's the left 3/4 of the page.
Just curious.

[cmwade77]

Chris,
Do you have a wide screen large display? My 19" only display's the left 3/4 of the page.
Just curious.

I do have a 24" widescreen as one of my displays; however, I normally edit LISP on my 19" screen......there appears to have some formatting issues when pasted into the post above, I have changed it to an attachment in my previous post.

[CAB]

Must be a tab setting. I removed all the tabs & posted it.

[cmwade77]

Strange, oh well, as long as it works, right 

[Lee Mac]

Chris,

If you are formatting code in the VLIDE, make sure this option is unchecked:

Tools > Environment Options > Visual LISP Format Options

Insert Tabs

[cmwade77]

Chris,

If you are formatting code in the VLIDE, make sure this option is unchecked:

Tools > Environment Options > Visual LISP Format Options

Insert Tabs

No, as specified, I use Notedpad++ and this is the first time that I have found it to be a major problem with formatting, not quite sure why.

[roy_043]

No, as specified, I use Notedpad++ and this is the first time that I have found it to be a major problem with formatting, not quite sure why.

Lee Mac is probably right: this is caused by the use of tabs, instead of spaces, for indentation.
To change this in Notepad++:
Settings > Preferences > Language Menu/Tab Settings > Check the "Replace by space" option

[roy_043]

Here's one that will move the text to the same OCS as the rectangle and rotate it to line up with one of its sides.
Just for practice...

Code: [Select]

(defun c:InRec2 ( / n:StopWithMessage polyEnt polyEntLst polySel ptLst ptMid ptSel txtEnt txtEntLst)
  (vl-load-com)
  (defun n:StopWithMessage (message)
    (princ message)
    nil
  )
  (if
    (and
      (setq txtEnt (car (entsel "\nSelect text: ")))
      (or
        (wcmatch (cdr (assoc 0 (setq txtEntLst (entget txtEnt)))) "*TEXT")
        (n:StopWithMessage "\nError: this is not a text ")
      )
      (setq polySel (entsel "\nSelect left part of top or bottom of rectangle (lwpolyline): "))
      (or
        (= (cdr (assoc 0 (setq polyEntLst (entget (setq polyEnt (car polySel)))))) "LWPOLYLINE")
        (n:StopWithMessage "\nError: this is not a lwpolyline ")
      )
      (or
        (= (length (setq ptLst (apply 'append (mapcar '(lambda (a) (if (= (car a) 10) (list (cdr a)))) polyEntLst)))) 4)
        (n:StopWithMessage "\nError: the number of vertices does not equal 4 ")
      )
    )
    (progn
      (setq
        ptSel
          (trans
            (vlax-curve-getclosestpointto
              (vlax-ename->vla-object polyEnt)
              (trans (osnap (cadr polySel) "_nea") 1 0)
            )
            0
            polyEnt
          ) ; ptSel in OCS poly
        ptMid (append (kg:MidPoint (car ptLst) (caddr ptLst)) (list (cdr (assoc 38 polyEntLst)))) ; ptMid in OCS poly
        ptLst (cons (last ptLst) ptLst)
      )
      ;; find the vertices ptSel is between and sort these points so that the point furthest from ptSel is the first in the list:
      (while
        (and
          (cadr ptLst)
          (not (equal (angle (car ptLst) ptSel) (angle ptSel (cadr ptLst)) 1e-8))
        )
        (setq ptLst (cdr ptLst))
      )
      (setq ptLst (vl-sort (list (car ptLst) (cadr ptLst)) '(lambda (a b) (> (distance a ptSel) (distance b ptSel)))))
      ;; modify the text:
      (if (= (cdr (assoc 0 txtEntLst)) "TEXT")
        (entmod
          (kg:ListSubstOrAppendAssocCar
            (list
              (cons 10 ptMid) ; this is just for the z-coord (in OCS)
              (cons 11 ptMid) ; this will determine the insertion point (in OCS)
              (cons 50 (angle ptSel (car ptLst)))
              '(72 . 1)
              '(73 . 2)
              (assoc 210 polyEntLst)
            )
            txtEntLst
          )
        )
        (entmod
          (kg:ListSubstOrAppendAssocCar
            (list
              (cons 10 (trans ptMid polyEnt 0))
              (cons 50 (angle ptSel (car ptLst)))
              '(71 . 5)
              (assoc 210 polyEntLst)
            )
            txtEntLst
          )
        )
      )
    )
  )
  (princ)
)

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

(defun kg:ListSubstOrAppendAssocCar (itemsLst lst / tmp)
  (foreach item itemsLst
    (if (setq tmp (assoc (car item) lst))
      (setq lst (subst item tmp lst))
      (setq lst (append lst (list item)))
    )
  )
)

(princ "\nUsage: InRec2 ")
(princ)


[Hugo]

@roy_043


Get this message

Select text:
Select left part of top or bottom of rectangle (lwpolyline): ; Fehler: no
function definition: KG:MIDPOINT

Bekomme diese Meldung

[roy_043]

@ Hugo:
I forgot two functions. I have updated the code in the original post.

[Hugo]

@roy_043

Super
Thanks works great now

Super
Danke funktioniert jetzt super