Jump to content

Area Label Lisp


Recommended Posts

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

Link to post
Share on other sites
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

Link to post
Share on other sites
(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)
)

Link to post
Share on other sites
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

Link to post
Share on other sites
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)
)

Link to post
Share on other sites
  • 4 weeks later...
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

Link to post
Share on other sites
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 by BIGAL
Link to post
Share on other sites
  • 1 year later...
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?

Link to post
Share on other sites
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 by Lee Mac
Link to post
Share on other sites
  • 1 year later...
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?

 

Link to post
Share on other sites
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?

Link to post
Share on other sites

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 by Lee Mac
Link to post
Share on other sites

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

 

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...