Topic: Text flag as Polyline

[cadplayer]

I want a code which can entmake a polyline some flag to destination.
I´m not sure if it haves code in forum here. But I´m testing a code which I have little manipulate. It works but if have a rotate text so rotate the text after selection. That´s not my intention.

Code: [Select]

(defun c:STR (/ foo ss r)
  ;; Strike through MText/Text (draw line through middle of selected text objects)
  ;; Alan J. Thompson, 09.20.10

  (defun foo (o / a b)
    (vla-getboundingbox o 'a 'b)
    (mapcar 'set '(a b) (mapcar 'vlax-safearray->list (list a b)))
    (list o
          (vlax-ename->vla-object
    (entmake
      (list
(cons 0 "LWPOLYLINE")
                (cons 100 "AcDbEntity")
                (cons 8 (getvar "clayer"))
                (cons 100 "AcDbPolyline")
                (cons 90 4)
                (list 10 (car b) (cadr a))
                (list 10 (car a) (cadr a))
(cons 10 (getpoint "\nDestination: "))
)
      )
   
          )
    )
  )

  (if (setq ss (ssget "_:E" '((0 . "MTEXT,TEXT"))))
    (progn
      (vlax-for x (setq ss (vla-get-activeselectionset
                             (cond (*AcadDoc*)
                                   ((setq *AcadDoc* (vla-get-activedocument
                                                      (vlax-get-acad-object)
                                                    )
                                    )
                                   )
                             )
                           )
                  )
        (setq r (vla-get-rotation x))
        (vla-put-rotation x 0.)
        (foreach i (foo x) (vla-rotate i (vla-get-insertionpoint x) r))
      )
      (vla-delete ss)
    )
  )
  (princ)
)



[cadplayer]

1)
I mean so here, is it possible to view the flag before setting
2)
Problem with function textbox. Is it realy textlength you can find in 2. list from textbox (I don´t think so) ?

((0.0 0.0 0.0) (1.60714 2.5 0.0)) can somebody explain what it means that two lists

3)
http://docs.autodesk.com/ACD/2011/ENU/filesALR/WS1a9193826455f5ff1a32d8d10ebc6b7ccc-690d.htm
understand I so that textbox is always the same regardless texthight

Code: [Select]

(defun c:str (/
      obj ; Textobject
      tb  ; Textbox
      tp  ; Insertpoint Text
      tl  ; Length Textbox
      ta  ; Text angle
      ip  ; Insertpoint flag
      )
(while
  (not
    (and
      (setq obj (car (entsel)))
      (wcmatch (cdr (assoc 0 (entget obj))) "TEXT")
      (if (= (cdr (assoc 0 (entget obj))) "TEXT")
(progn
  (setq tb (textbox (list (assoc 1 (entget obj)))))
  (setq tp (cdr (assoc 10 (entget obj))))
  (setq tl (car (nth 1 tb)))
  (setq ta (cdr (assoc 50 (entget obj))))
  (setq ip (polar tp (+ ta (* 0.5 pi)) (- 0.5)))
  )
)
      )
    )
  (princ "\n    Select a text! ")
  )
(if tb
  (entmake
      (list
(cons 0 "LWPOLYLINE")
                (cons 100 "AcDbEntity")
                (cons 8 (getvar "clayer"))
                (cons 100 "AcDbPolyline")
                (cons 90 4)
(cons 10 (polar ip ta tl))
                (cons 10 ip)
(cons 10 (getpoint "\nDestination: "))
)
    )
  )
)
   



[cadplayer]

Maybe is there a better way, code okay - you can test it.

Code: [Select]

(defun c:txf (/
      obj ; Textobject
      tb  ; Textbox
      tp  ; Insertpoint Text
      tl  ; Length Textbox
      ta  ; Text angle
      ip  ; Insertpoint flag
      fp  ; Insertpoint flag
      fm  ; flagmid
      ip1 ; Text left
      ip2 ; Text right

      )
(while
  (not
    (and
      (setq obj (car (entsel)))
      (wcmatch (cdr (assoc 0 (entget obj))) "TEXT")
      (if (= (cdr (assoc 0 (entget obj))) "TEXT")
(progn
  (setq tb (textbox (entget obj)))
  (setq tp (cdr (assoc 10 (entget obj))))
  (setq tl (car (nth 1 tb)))
  (setq ta (cdr (assoc 50 (entget obj))))
  (setq ip1 (polar tp (+ ta (* 0.5 pi)) (- (* (nth 1 (nth 1 tb)) 0.5))))
  (setq ip2 (polar ip1 ta tl))
  (setq fp (getpoint "\n    Destination! "))
  )
)
      )
    )
  (princ "\n    Select a text! ")
  )
  (setq fp (trans fp 0 1))
  (setq ip1 (trans ip1 0 1))
  (setq ip2 (trans ip2 0 1))
  (setq fm (polar ip1 (angle ip1 ip2) (/ (distance ip1 ip2) 2.)))
  (cond
    ((< (nth 0 fp) (nth 0 fm))
     (command "_pline" ip2 ip1 fp (command Pt))
     )
    ((> (nth 0 fp) (nth 0 fm))
     (command "_pline" ip1 ip2 fp (command Pt))
     )
    )
  (command "_ucs" "_w")
  )
(princ "Textflag Run with > txf < ")


[roy_043]

2.
The list returned by the (textbox) function contains two points. The first point in the bottom left point, the last point is the top right point of the bounding box. To calculate the width of the text:

Code - Auto/Visual Lisp: [Select]

1. (setq elist (entget (car (entsel))))
2. (setq pts (textbox elist))
3. (setq width (- (caadr pts) (caar pts)))

3.
The text height in the entity list does influence the result of (textbox). But if an incomplete elist is passed to the function current settings are used for missing information such as textsize.

[roy_043]

Why not use a leader?

[cadplayer]

I´m not sure with mleader-entity. Have you a example to entmake a mleader. I only can do with command and it have no oportunties to change mleader-properties

Code: [Select]

(while
  (not
    (and
      (setq obj (car (entsel)))
      (wcmatch (cdr (assoc 0 (entget obj))) "TEXT,MTEXT")
      (if (or (= (cdr (assoc 0 (entget obj))) "TEXT") "MTEXT")
(progn
;;;   (setq tb (textbox (entget obj)))
  (setq tp (cdr (assoc 10 (entget obj))))
;;;   (setq tl (car (nth 1 tb)))
  (setq ta (cdr (assoc 50 (entget obj))))
  (setq tx (cdr (assoc 1 (entget obj))))
;;;   (setq ip1 (polar tp (+ ta (* 0.5 pi)) (- (* (nth 1 (nth 1 tb)) 0.2))))
;;;   (setq ip2 (polar ip1 ta tl))
;;;   (setq fp (getpoint "\n    Destination! "))
;;;   (setq fm (polar ip1 (angle ip1 ip2) (/ (distance ip1 ip2) 2.)))
  )
)
      )
    )
  (princ "\n    Select a text! ")
  )
  (progn
    (command "_ucs" "_z" (* ta (/ 180 pi)))
    (command "_mleader"  (getpoint "\n    Destination! ") (trans tp 0 1) tx)
    (command "_ucs" "_w")
    (princ)
    )
  (entdel obj)
  )