GA.LSP - Is it possible to insert tilted text according to object rotation?

[Anonymous]

Boa noite! Os amigos poderiam me ajudar com essa dúvida, adorei essa rotina "GA.lsp" que encontrei na publicação abaixo. O mesmo é muito útil em trabalhos topográficos! É possível que o texto seja inserido na mesma direção que o lote? Para ser inclinado de acordo com o maior comprimento do retângulo?
Como na imagem anexada à publicação! Obrigado pela ajuda de seus amigos!

Link rotina de postagem GA.LSP:   https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/area-label-lisp-routine/td-p/3347647

Download do link -  rotina GA.LSP:    https://forums.autodesk.com/autodesk/attachments/autodesk/130/302499/1/GA.lsp

Maycoln Anderson

São Paulo, Brasil

[Kent1Cooper]

Welcome to these Forums!

That should be achievable easily enough, if there isn't already one out there that does it that way, but questions arise:

What about non-rectangular ones?  Should the Text rotation align with the longest single edge, or the average angle between long opposite edges?

I assume there could be arc edges in some places.  What if one of the long edges is [or includes] an arc?

Also, I think it could be done much more simply.  That one HATCHes in the area temporarily, extracts the perimeter from the Hatch pattern [in a more complicated way than necessary], and constructs a Polyline boundary [and a heavy one at that!], and deletes the Hatch pattern, whereas it could just use the BOUNDARY command.

[stevor]

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/length-and-width-of-rectangle-as-tex...

may have some resources, as applied to rectangles at non orthogonal orientation.

[Ranjit_Singh]

try below for example

;: Ranjit Singh
;; 8/17/17
(defun c:somefunc  (/ ent ang dat)
 (entmakex
  (list '(0 . "TEXT")
        '(10 0 0 0)
        '(40 . 0.1)
        (cons 1
              (strcat "AREA="
                      (rtos (getpropertyvalue (setq ent (car (entsel "\nSelect rectangle: "))) "Area") 2 4)))
        (cons 50
              (+ (setq ang (progn (setq dat (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent))))))
                                  (apply 'angle
                                         (cdar (vl-sort (mapcar '(lambda (x y) (cons (distance x y) (list x y))) dat (cdr dat))
                                                        '(lambda (x y) (> (car x) (car y))))))))
                 (if (and (>= (* 1.5 pi) ang) (> ang (* 0.5 pi)))
                  pi
                  0)))
        '(72 . 1)
        (cons 11 (mapcar '/ (mapcar '+ (car dat) (caddr dat)) '(2 2)))
        '(73 . 2))))

Call this in your overall function with all the necessary error traps.

[F.Camargo]

---

@Ranjit_Singh wrote:

try below for example

;: Ranjit Singh
;; 8/17/17
(defun c:somefunc  (/ ent ang dat)
 (entmakex
  (list '(0 . "TEXT")
        '(10 0 0 0)
        '(40 . 0.1)
        (cons 1
              (strcat "AREA="
                      (rtos (getpropertyvalue (setq ent (car (entsel "\nSelect rectangle: "))) "Area") 2 4)))
        (cons 50
              (+ (setq ang (progn (setq dat (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent))))))
                                  (apply 'angle
                                         (cdar (vl-sort (mapcar '(lambda (x y) (cons (distance x y) (list x y))) dat (cdr dat))
                                                        '(lambda (x y) (> (car x) (car y))))))))
                 (if (and (>= (* 1.5 pi) ang) (> ang (* 0.5 pi)))
                  pi
                  0)))
        '(72 . 1)
        (cons 11 (mapcar '/ (mapcar '+ (car dat) (caddr dat)) '(2 2)))
        '(73 . 2))))

Call this in your overall function with all the necessary error traps.

---

@Ranjit_Singh

Fantastic code!! Congrats!!!

It will be better if is text as a field. 🙂

Fabricio

[Ranjit_Singh · Accepted solution]

I think this will work.

;; Ranjit Singh
;; 8/17/17
(defun c:somefunc  (/ ent ang dat)
 (entmakex
  (list '(0 . "TEXT")
        '(10 0 0 0)
        '(40 . 0.1)
        (cons 1
              (strcat "AREA=%<\\AcObjProp Object(%<\\_ObjId "
                      (itoa (vla-get-objectid (vlax-ename->vla-object (setq ent (car (entsel))))))
                      ">%).Area \\f \"%lu2\">%"))
        (cons 50
              (+ (setq ang (progn (setq dat (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent))))))
                                  (apply 'angle
                                         (cdar (vl-sort (mapcar '(lambda (x y) (cons (distance x y) (list x y))) dat (cdr dat))
                                                        '(lambda (x y) (> (car x) (car y))))))))
                 (if (and (>= (* 1.5 pi) ang) (> ang (* 0.5 pi)))
                  pi
                  0)))
        '(72 . 1)
        (cons 11 (mapcar '/ (mapcar '+ (car dat) (caddr dat)) '(2 2)))
        '(73 . 2))))

[F.Camargo]

---

@Ranjit_Singh wrote:

I think this will work.

;; Ranjit Singh
;; 8/17/17
(defun c:somefunc  (/ ent ang dat)
 (entmakex
  (list '(0 . "TEXT")
        '(10 0 0 0)
        '(40 . 0.1)
        (cons 1
              (strcat "AREA=%<\\AcObjProp Object(%<\\_ObjId "
                      (itoa (vla-get-objectid (vlax-ename->vla-object (setq ent (car (entsel))))))
                      ">%).Area \\f \"%lu2\">%"))
        (cons 50
              (+ (setq ang (progn (setq dat (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent))))))
                                  (apply 'angle
                                         (cdar (vl-sort (mapcar '(lambda (x y) (cons (distance x y) (list x y))) dat (cdr dat))
                                                        '(lambda (x y) (> (car x) (car y))))))))
                 (if (and (>= (* 1.5 pi) ang) (> ang (* 0.5 pi)))
                  pi
                  0)))
        '(72 . 1)
        (cons 11 (mapcar '/ (mapcar '+ (car dat) (caddr dat)) '(2 2)))
        '(73 . 2))))

---

@Ranjit_Singh

Very nice code!

Thank you very much! 🙂

Regards

Fabricio

[Anonymous]

Good afternoon! Sorry for the delay in responding! I come across this message to thank all the friends who helped, suggested ideas! Great codes, the same already meets what I need! Thank you all! God bless!

Maycoln Anderson

São Paulo, Brasil

[F.Camargo]

I'm trying to modify the code to selected multiple objects.

;: Ranjit Singh
;; 8/17/17
(defun c:somefunc1  (/ ent ang dat h)
  (setq o_layer (getvar 'CLAYER))
  (setq o_echo (getvar 'CMDECHO))
  (setvar 'CMDECHO 0)
  (command "_.layer" "_T" "-AREA-LOTE" "_M" "-AREA-LOTE" "c" "1" "" ""
	   "_.layer" "_T" "-AREA-LOTE" "_U" "-AREA-LOTE" "_M" "-AREA-LOTE" "c" "2" "" "")

  ;; Text height
 (if
    (setq h (getdist (strcat "\nSpecify text height <" (rtos (getvar 'textsize)) ">: ")))
 (setvar 'textsize h)
 (setq h (getvar 'textsize))
 )
 (entmakex
  (list '(0 . "TEXT")
        '(10 0 0 0)
        (cons 40  h);; text height
        (cons 1
              (strcat
                      (vl-string-translate "." "," (rtos (princ "\nSelect objects (polylines/circles/ellipses): ")
(getpropertyvalue (setq ent (ssget '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))))"Area") 2 2)) "m²"))
        (cons 50
              (+ (setq ang (progn (setq dat (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent))))))
                                  (apply 'angle
                                         (cdar (vl-sort (mapcar '(lambda (x y) (cons (distance x y) (list x y))) dat (cdr dat))
                                                        '(lambda (x y) (> (car x) (car y))))))))
                 (if (and (>= (* 1.5 pi) ang) (> ang (* 0.5 pi)))
                  pi
                  0)))
        '(72 . 1)
        (cons 11 (mapcar '/ (mapcar '+ (car dat) (caddr dat)) '(2 2)))
        '(73 . 2)))

 
(setvar 'CLAYER o_layer)
(setvar 'CMDECHO o_echo)
(PRINC)
)

Is it possible?

Thank in advance

Fabricio

[Anonymous]

Good morning mate! The original code is very good, if you have the possibility to select all at once, it would be the maximum! Perfect! I'm just an autocad user, I do not understand programming! Thanks again for your work! Congratulations

Maycoln Anderson - São Paulo, Brasil

[Ranjit_Singh]

Something like this to label multiple rectangles. Add error traps.

;;Ranjit Singh
;;8/22/17
(defun c:somefunc  (/ ent ang dat)
 (mapcar '(lambda (x)
           (entmakex
            (list '(0 . "TEXT")
                  '(10 0 0 0)
                  '(40 . 0.1)
                  (cons 1
                        (strcat "AREA=%<\\AcObjProp Object(%<\\_ObjId "
                                (itoa (vla-get-objectid (vlax-ename->vla-object (setq ent x))))
                                ">%).Area \\f \"%lu2\">%"))
                  (cons 50
                        (+ (setq ang (progn (setq dat (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent))))))
                                            (apply 'angle
                                                   (cdar (vl-sort (mapcar '(lambda (x y) (cons (distance x y) (list x y))) dat (cdr dat))
                                                                  '(lambda (x y) (> (car x) (car y))))))))
                           (if (and (>= (* 1.5 pi) ang) (> ang (* 0.5 pi)))
                            pi
                            0)))
                  '(72 . 1)
                  (cons 11 (mapcar '/ (mapcar '+ (car dat) (caddr dat)) '(2 2)))
                  '(73 . 2))))
         (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE"))))))))

[F.Camargo]

---

@Ranjit_Singh wrote:

Something like this to label multiple rectangles. Add error traps.

;;Ranjit Singh
;;8/22/17
(defun c:somefunc  (/ ent ang dat)
 (mapcar '(lambda (x)
           (entmakex
            (list '(0 . "TEXT")
                  '(10 0 0 0)
                  '(40 . 0.1)
                  (cons 1
                        (strcat "AREA=%<\\AcObjProp Object(%<\\_ObjId "
                                (itoa (vla-get-objectid (vlax-ename->vla-object (setq ent x))))
                                ">%).Area \\f \"%lu2\">%"))
                  (cons 50
                        (+ (setq ang (progn (setq dat (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget ent))))))
                                            (apply 'angle
                                                   (cdar (vl-sort (mapcar '(lambda (x y) (cons (distance x y) (list x y))) dat (cdr dat))
                                                                  '(lambda (x y) (> (car x) (car y))))))))
                           (if (and (>= (* 1.5 pi) ang) (> ang (* 0.5 pi)))
                            pi
                            0)))
                  '(72 . 1)
                  (cons 11 (mapcar '/ (mapcar '+ (car dat) (caddr dat)) '(2 2)))
                  '(73 . 2))))
         (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE"))))))))

---

@Ranjit_Singh

millions of kudos for you mate.

Very nice code! 🙂

I'm gonna study your code to learning good things.

Thanks

Fabricio

[ArchD]

I don't know if I'll ever need this, but I'm snagging a copy of it because I know if I don't get it now I'll need it in the future and won't be able to find it. Awesome.

[Anonymous]

Congratulations! Very good! Perfect! Thanks everyone for the help!

Maycoln Anderson

São Paulo, Brasil