Area Label Lisp

[folderdash]

Hi

 

I am looking for a lisp that;

 

1. Step : I select the single polyline,

2. Step : I select the existing text and it changes to the area value divided by 5.

 

Thank you

[asos2000]

Start with this

[folderdash]

Start with this

 

Thanks for your reply but i allready tried this.I need exactly what i wrote above.

[Lee Mac]

In my code, change the conversion factor (cf) to 0.2 and change the field formatting (fo) to something like "%lu6%qf1%ct8[0.2]"

[folderdash]

Hi

 

Thank you very much for your reply but I know nothing about lisp language and sorry about that.

 

I have found a lisp attached that is the closest lisp for my needs.

 

I f you can help me to :

 

- divide measured area to 5,

- make it 2 digits after comma,

- delete suffix "m2" after the number.

 

Thank you very much.

AT.lsp

[rlx]

(vl-load-com);; this lisp is writing by hmsilva
(defun c:AT (/ flag poly poly-obj str txt txt-obj)
 ;; mostafa baran 
 (setq txt T)
 (while (and txt
             (setq poly (car (entsel "\nSelect Closed Polyline <exit>: ")))
        )
   (if (and (setq poly-obj (vlax-ename->vla-object poly))
            (wcmatch (vla-get-objectname poly-obj) "AcDbPolyline,AcDb2Polyline")
       )
     (if (and (= (vla-get-Closed poly-obj) :vlax-true)
              [color=red][b](setq str (strcat (rtos (/ (vla-get-area poly-obj) 5) 2 2)))[/b][/color]
              (setq flag T)
         )
       (while flag
         (if (setq txt (car (entsel "\nSelect Target Text Object <exit>: ")))
           (if (and (setq txt-obj (vlax-ename->vla-object txt))
                    (wcmatch (vla-get-objectname txt-obj) "AcDbText,AcDbMText")
               )
             (if (vlax-write-enabled-p txt-obj)
               (progn
                 (vla-put-TextString txt-obj str)
                 (setq flag nil)
               )
               (prompt "\nText/Mtext object's layer is locked...")
             )
             (prompt "\nDidn't select a Text/Mtext object...")
           )
           (setq flag nil)
         )
       )
       (prompt "\nSelected Polyline isn't closed!!!")
     )
     (prompt "\nDidn't select a Polyline!!!")
   )
 )
 (princ)
)

[folderdash]

(vl-load-com);; this lisp is writing by hmsilva
(defun c:AT (/ flag poly poly-obj str txt txt-obj)
 ;; mostafa baran 
 (setq txt T)
 (while (and txt
             (setq poly (car (entsel "\nSelect Closed Polyline <exit>: ")))
        )
   (if (and (setq poly-obj (vlax-ename->vla-object poly))
            (wcmatch (vla-get-objectname poly-obj) "AcDbPolyline,AcDb2Polyline")
       )
     (if (and (= (vla-get-Closed poly-obj) :vlax-true)
              [color=red][b](setq str (strcat (rtos (/ (vla-get-area poly-obj) 5) 2 2)))[/b][/color]
              (setq flag T)
         )
       (while flag
         (if (setq txt (car (entsel "\nSelect Target Text Object <exit>: ")))
           (if (and (setq txt-obj (vlax-ename->vla-object txt))
                    (wcmatch (vla-get-objectname txt-obj) "AcDbText,AcDbMText")
               )
             (if (vlax-write-enabled-p txt-obj)
               (progn
                 (vla-put-TextString txt-obj str)
                 (setq flag nil)
               )
               (prompt "\nText/Mtext object's layer is locked...")
             )
             (prompt "\nDidn't select a Text/Mtext object...")
           )
           (setq flag nil)
         )
       )
       (prompt "\nSelected Polyline isn't closed!!!")
     )
     (prompt "\nDidn't select a Polyline!!!")
   )
 )
 (princ)
)

 

Thank you very much

[asos2000]

This is field version

(vl-load-com);; this lisp is writing by hmsilva
(defun c:AT (/ flag poly poly-obj str txt txt-obj)
 ;; mostafa baran 
 (setq txt T)
 (while (and txt
             (setq poly (car (entsel "\nSelect Closed Polyline <exit>: ")))
        )
   (if (and (setq poly-obj (vlax-ename->vla-object poly))
            (wcmatch (vla-get-objectname poly-obj) "AcDbPolyline,AcDb2Polyline")
       )
     (if (and (= (vla-get-Closed poly-obj) :vlax-true)
       (setq poly-obj-id (vla-get-objectid poly-obj))
       (setq str (strcat "%<\\AcObjProp Object(%<\\_ObjId "
			   (itoa poly-obj-id)
			   " >%).Area \\f \"%lu2%pr2%ct8[0.2]\">%"))
              (setq flag T)
         )
       (while flag
         (if (setq txt (car (entsel "\nSelect Target Text Object <exit>: ")))
           (if (and (setq txt-obj (vlax-ename->vla-object txt))
                    (wcmatch (vla-get-objectname txt-obj) "AcDbText,AcDbMText")
               )
             (if (vlax-write-enabled-p txt-obj)
               (progn
                 (vla-put-TextString txt-obj str)
                 (setq flag nil)
               )
               (prompt "\nText/Mtext object's layer is locked...")
             )
             (prompt "\nDidn't select a Text/Mtext object...")
           )
           (setq flag nil)
         )
       )
       (prompt "\nSelected Polyline isn't closed!!!")
     )
     (prompt "\nDidn't select a Polyline!!!")
   )
 )
 (princ)
)

[folderdash]

(vl-load-com);; this lisp is writing by hmsilva
(defun c:AT (/ flag poly poly-obj str txt txt-obj)
 ;; mostafa baran 
 (setq txt T)
 (while (and txt
             (setq poly (car (entsel "\nSelect Closed Polyline <exit>: ")))
        )
   (if (and (setq poly-obj (vlax-ename->vla-object poly))
            (wcmatch (vla-get-objectname poly-obj) "AcDbPolyline,AcDb2Polyline")
       )
     (if (and (= (vla-get-Closed poly-obj) :vlax-true)
              [color=red][b](setq str (strcat (rtos (/ (vla-get-area poly-obj) 5) 2 2)))[/b][/color]
              (setq flag T)
         )
       (while flag
         (if (setq txt (car (entsel "\nSelect Target Text Object <exit>: ")))
           (if (and (setq txt-obj (vlax-ename->vla-object txt))
                    (wcmatch (vla-get-objectname txt-obj) "AcDbText,AcDbMText")
               )
             (if (vlax-write-enabled-p txt-obj)
               (progn
                 (vla-put-TextString txt-obj str)
                 (setq flag nil)
               )
               (prompt "\nText/Mtext object's layer is locked...")
             )
             (prompt "\nDidn't select a Text/Mtext object...")
           )
           (setq flag nil)
         )
       )
       (prompt "\nSelected Polyline isn't closed!!!")
     )
     (prompt "\nDidn't select a Polyline!!!")
   )
 )
 (princ)
)

 

Hi

 

That lisp really helped me a lot.

 

1- Is it possible to select multiple polylines and right click to select the target text to write the "total area of polylines/5" in the same format?

 

2- Is it possible to make the same things with multiple hatches instead of polylines?

 

Thank you

[BIGAL]

1 yes

2 yes

 

Use a ssget with "AcDbPolyline,AcDb2Polyline,AcDbhatch" filters so no need to check entity type, total up the areas, then divide / 5.

 

3 need to rewrite the 1st half of the code above.

 

(vl-load-com)

;; this lisp is writen by Alan H may 2018
;; based on original code by hmsilva
;; multiple area total MAT

(defun c:MAT (/ flag polyss poly-obj str txt txt-obj)
 (setq tot 0)
 (setq flag T)
 (princ "\nChoose objects plines hatch")
     (setq polyss (ssget (list(cons 0 "lwPolyline,3dPolyline,Hatch"))))
     (repeat (setq x (sslength polyss))
  (setq poly-obj (vlax-ename->vla-object (ssname polyss (setq x (- x 1)))))
       (if (wcmatch (vla-get-objectname poly-obj) "AcDbPolyline,AcDb2Polyline")
         (if (= (vla-get-Closed poly-obj) :vlax-true)
               (setq tot (+ tot (/ (vla-get-area poly-obj) 5.0)))
         )
	  (setq tot (+ tot (/ (vla-get-area poly-obj) 5.0)))
	)
	)
	(setq str (strcat (rtos tot 2 2)))
       (while flag
         (if (setq txt (car (entsel "\nSelect Target Text Object <exit>: ")))
           (if (and (setq txt-obj (vlax-ename->vla-object txt))
                    (wcmatch (vla-get-objectname txt-obj) "AcDbText,AcDbMText")
               )
             (if (vlax-write-enabled-p txt-obj)
               (progn
                 (vla-put-TextString txt-obj str)
                 (setq flag nil)
               )
               (prompt "\nText/Mtext object's layer is locked...")
             )
             (prompt "\nDidn't select a Text/Mtext object...")
           )
           (setq flag nil)
         )
       )
 (princ)
)

Edited May 5, 2018 by BIGAL

[folderdash]

You are great my friend.Thanks so much.

[kwmin]

On ‎4‎/‎11‎/‎2018 at 2:48 AM, Lee Mac said:

In my code, change the conversion factor (cf) to 0.2 and change the field formatting (fo) to something like "%lu6%qf1%ct8[0.2]"

 

I want to express it to the second decimal place.

 

What should I do?

[Lee Mac]

7 hours ago, kwmin said:

I want to express it to the second decimal place.

 

What should I do?

 

You may follow the instructions I provided here under the section entitled 'Length / Area Formatting Code' to determine the appropriate field formatting code to use with the program - the formatting code will be the same, whether used with the Area Label program or the Length & Area Field program.

Edited February 20, 2020 by Lee Mac

[pafewu]

On 20/02/2020 at 14:13, Lee Mac said:

 

You may follow the instructions I provided here under the section entitled 'Length / Area Formatting Code' to determine the appropriate field formatting code to use with the program - the formatting code will be the same, whether used with the Area Label program or the Length & Area Field program.

is it possible to run this on Autocad for mac?

area tag?

 

[pafewu]

i was using this lisp on PC, but on mac it doesn't work

areatagPE.lsp

[Jonathan Handojo]

I'm not sure if AutoLISP is supported on Mac. Last I tried, it was the same result with me, so I think that's the main reason (unfortunately).

[pafewu]

1 hour ago, Jonathan Handojo said:

I'm not sure if AutoLISP is supported on Mac. Last I tried, it was the same result with me, so I think that's the main reason (unfortunately).

you can uppload certain lisp files. but the attached one is not working as "error: no function definition: VLAX-ENAME->VLA-OBJECT" error is being displayed.

i dont know if it is possible to create lisp file on mac, that can write object property (i.e. area) to field in attribute?

[Lee Mac]

AutoCAD for Mac does not support the ActiveX component of Visual LISP, as this is a proprietary Microsoft technology; as such, as a general rule for you to easily determine the Mac compatibility of a program: any AutoLISP program containing the functions vlax-get-acad-object or vlax-ename->vla-object will not be compatible on the Mac platform. In some cases, the ActiveX expressions can be ported for compatibility using the getpropertyvalue & setpropertyvalue functions as a workaround, however, a direct translation may not be possible for every expression.

Edited May 3, 2021 by Lee Mac

[BIGAL]

Your in luck if you have a pline etc with all straights you can use 1st principles of an area from points, will try to find and example. What about the getproperty function I think the Mac may work with that. (getpropertyvalue (entlast) "area") dont have Mac version, Getproperty is not supported on BricscadV20.

 

; I think this was by PBE for checking  clockwise plines.

(defun ss-pts2area  (l)
(/ (apply (function +)
            (mapcar (function (lambda (x y)
                                (- (* (car x) (cadr y)) (* (car y) (cadr x)))))
                    (cons (last l) l)
                    l)) 
2.)
)

(setq plent (entsel "\nPick pline"))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))

(setq area (abs (ss-pts2area co-ord) ))