Jump to content

Display hatch area as a label

Organic

By Organic
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Organic Grand Master

Organic

Posted
  • Author
Posted

Thanks. It is probably time I got around to learning lisp.

  • Replies 50
  • Created
  • Last Reply

Top Posters In This Topic

  • Organic

    8

  • Lee Mac

    7

  • ReMark

    5

  • pkenewell

    4

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Lee Mac Grand Master

Lee Mac

Posted
Posted
How do I divide the area by a factor? E.g. if I wanted to divide it by a factor 10

 

In mine, change:

 

([color=BLUE]cons[/color] 01 ([color=BLUE]rtos[/color] ([color=BLUE]vla-get-area[/color] ([color=BLUE]vlax-ename->vla-object[/color] e))))

to:

([color=BLUE]cons[/color] 01 ([color=BLUE]rtos[/color] [highlight]([color=blue]/[/color][/highlight] ([color=BLUE]vla-get-area[/color] ([color=BLUE]vlax-ename->vla-object[/color] e)) [highlight]10.0)[/highlight]))

  • 2 weeks later...
ahmadsalihin Newbie

ahmadsalihin

Posted
Posted

thanx 4 ur effort GP, hope u willing 2 help me to get this: i've modified ur lisp so it gives me area in acre format but how to make additional format such as area in hactare under the area in acre so then the area has two area information which are acre and hactare..

SunnyTurtle Collaborator

SunnyTurtle

Posted
Posted

Just another solution maybe.

 

You could use a mtext field so that when you modify the polyline you get the new area with out running the lisp again.

GP_ Rising Star

GP_

Posted
Posted
thanx 4 ur effort GP, hope u willing 2 help me to get this: i've modified ur lisp so it gives me area in acre format but how to make additional format such as area in hactare under the area in acre so then the area has two area information which are acre and hactare..

 

 

Try MTEXT.

 

(setq t1 "acres")    ;enter string acres value
(setq t2 "hectares") ;enter string hectares value
(setq txt (strcat t1 "[url="file://\\P"]\\P[/url]" t2))
(entmake
   (list
       (cons 0 "MTEXT")
       (cons 8 (getvar "clayer"))
       (cons 100 "AcDbEntity")
       (cons 100 "AcDbMText")        
       (cons 7 (getvar "textstyle"))
       (cons 10 P_center)
       (cons 71 5)
       (cons 1 txt)
   )
)

ahmadsalihin Newbie

ahmadsalihin

Posted
Posted

special thanx 4 GP wiling to share..

stevesfr Rising Star

stevesfr

Posted
Posted
Try this quickly written program, based on my Area Label program:

 

([color=BLUE]defun[/color] c:quickarea ( [color=BLUE]/[/color] *error* c e l p v x )

   ([color=BLUE]defun[/color] *error* ( msg )
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'int ([color=BLUE]type[/color] v))
           ([color=BLUE]setvar[/color] 'cmdecho v)
       )
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
           ([color=BLUE]entdel[/color] e)
       )
       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg) [color=MAROON]"*BREAK,*CANCEL*,*EXIT*"[/color]))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
       )
       ([color=BLUE]princ[/color])
   )
   ([color=BLUE]setq[/color] v ([color=BLUE]getvar[/color] 'cmdecho))
   ([color=BLUE]setvar[/color] 'cmdecho 0)
   
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nPick Area <Exit>: "[/color]))
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
           ([color=BLUE]progn[/color]
               ([color=BLUE]entdel[/color] e)
               ([color=BLUE]setq[/color] e [color=BLUE]nil[/color])
           )
       )
       ([color=BLUE]setq[/color] x ([color=BLUE]entlast[/color]))
       ([color=BLUE]command[/color] [color=MAROON]"_.-boundary"[/color] [color=MAROON]"_A"[/color] [color=MAROON]"_B"[/color] [color=MAROON]"_E"[/color] [color=MAROON]"_I"[/color] [color=MAROON]"_N"[/color] [color=MAROON]""[/color] [color=MAROON]"_O"[/color] [color=MAROON]"_P"[/color] [color=MAROON]""[/color] [color=MAROON]"_non"[/color] p [color=MAROON]""[/color])
       ([color=BLUE]if[/color]
           ([color=BLUE]and[/color]
               ([color=BLUE]not[/color] ([color=BLUE]eq[/color] x ([color=BLUE]setq[/color] e ([color=BLUE]entlast[/color]))))
               ([color=BLUE]=[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] e))))
           )
           ([color=BLUE]progn[/color]
               ([color=BLUE]foreach[/color] x ([color=BLUE]entget[/color] e)
                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))
                       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] x) l))
                   )
               )
               ([color=BLUE]setq[/color] c ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] l)) ([color=BLUE]list[/color] ([color=BLUE]length[/color] l) ([color=BLUE]length[/color] l))))
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"TEXT"[/color])
                       ([color=BLUE]cons[/color] 40 ([color=BLUE]getvar[/color] 'textsize))
                       ([color=BLUE]cons[/color] 07 ([color=BLUE]getvar[/color] 'textstyle))
                       ([color=BLUE]cons[/color] 01 ([color=BLUE]rtos[/color] ([color=BLUE]vla-get-area[/color] ([color=BLUE]vlax-ename->vla-object[/color] e))))
                       ([color=BLUE]cons[/color] 10 c)
                       ([color=BLUE]cons[/color] 11 c)
                      '(72 . 1)
                      '(73 . 2)
                   )
               )
               ([color=BLUE]redraw[/color] e 3)
               ([color=BLUE]setq[/color] l [color=BLUE]nil[/color])
           )
           ([color=BLUE]setq[/color] e [color=BLUE]nil[/color])
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
       ([color=BLUE]entdel[/color] e)
   )
   ([color=BLUE]setvar[/color] 'cmdecho v)
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

Lee, I sure can't get this to work. Does it work for others ? using vanilla AC2008. TIA, Steve

Lee Mac Grand Master

Lee Mac

Posted
Posted
Lee, I sure can't get this to work. Does it work for others ? using vanilla AC2008. TIA, Steve

 

Hi Steve, the code works well in my brief tests - what error do you receive, if any?

stevesfr Rising Star

stevesfr

Posted
Posted
Hi Steve, the code works well in my brief tests - what error do you receive, if any?

 

Lee, dummy me, I had frozen a layer after testing program.... all is well. code works fine. my stupidity...distraction.

Thx, Steve

  • 4 months later...
Organic Grand Master

Organic

Posted
  • Author
Posted
Try this quickly written program, based on my Area Label program:

 

([color=BLUE]defun[/color] c:quickarea ( [color=BLUE]/[/color] *error* c e l p v x )

   ([color=BLUE]defun[/color] *error* ( msg )
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'int ([color=BLUE]type[/color] v))
           ([color=BLUE]setvar[/color] 'cmdecho v)
       )
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
           ([color=BLUE]entdel[/color] e)
       )
       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg) [color=MAROON]"*BREAK,*CANCEL*,*EXIT*"[/color]))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
       )
       ([color=BLUE]princ[/color])
   )
   ([color=BLUE]setq[/color] v ([color=BLUE]getvar[/color] 'cmdecho))
   ([color=BLUE]setvar[/color] 'cmdecho 0)
   
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nPick Area <Exit>: "[/color]))
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
           ([color=BLUE]progn[/color]
               ([color=BLUE]entdel[/color] e)
               ([color=BLUE]setq[/color] e [color=BLUE]nil[/color])
           )
       )
       ([color=BLUE]setq[/color] x ([color=BLUE]entlast[/color]))
       ([color=BLUE]command[/color] [color=MAROON]"_.-boundary"[/color] [color=MAROON]"_A"[/color] [color=MAROON]"_B"[/color] [color=MAROON]"_E"[/color] [color=MAROON]"_I"[/color] [color=MAROON]"_N"[/color] [color=MAROON]""[/color] [color=MAROON]"_O"[/color] [color=MAROON]"_P"[/color] [color=MAROON]""[/color] [color=MAROON]"_non"[/color] p [color=MAROON]""[/color])
       ([color=BLUE]if[/color]
           ([color=BLUE]and[/color]
               ([color=BLUE]not[/color] ([color=BLUE]eq[/color] x ([color=BLUE]setq[/color] e ([color=BLUE]entlast[/color]))))
               ([color=BLUE]=[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] e))))
           )
           ([color=BLUE]progn[/color]
               ([color=BLUE]foreach[/color] x ([color=BLUE]entget[/color] e)
                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))
                       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] x) l))
                   )
               )
               ([color=BLUE]setq[/color] c ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] l)) ([color=BLUE]list[/color] ([color=BLUE]length[/color] l) ([color=BLUE]length[/color] l))))
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"TEXT"[/color])
                       ([color=BLUE]cons[/color] 40 ([color=BLUE]getvar[/color] 'textsize))
                       ([color=BLUE]cons[/color] 07 ([color=BLUE]getvar[/color] 'textstyle))
                       ([color=BLUE]cons[/color] 01 ([color=BLUE]rtos[/color] ([color=BLUE]vla-get-area[/color] ([color=BLUE]vlax-ename->vla-object[/color] e))))
                       ([color=BLUE]cons[/color] 10 c)
                       ([color=BLUE]cons[/color] 11 c)
                      '(72 . 1)
                      '(73 . 2)
                   )
               )
               ([color=BLUE]redraw[/color] e 3)
               ([color=BLUE]setq[/color] l [color=BLUE]nil[/color])
           )
           ([color=BLUE]setq[/color] e [color=BLUE]nil[/color])
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
       ([color=BLUE]entdel[/color] e)
   )
   ([color=BLUE]setvar[/color] 'cmdecho v)
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

I found myself needing this again and found this thread via Google :)

 

Is it an easy change to make the lisp give the area to 2dp instead of 3dp?

Lee Mac Grand Master

Lee Mac

Posted
Posted

Change:

([color=BLUE]cons[/color] 01 ([color=BLUE]rtos[/color] ([color=BLUE]vla-get-area[/color] ([color=BLUE]vlax-ename->vla-object[/color] e))))

 

to:

([color=BLUE]cons[/color] 01 ([color=BLUE]rtos[/color] ([color=BLUE]vla-get-area[/color] ([color=BLUE]vlax-ename->vla-object[/color] e)) [highlight]2 2[/highlight]))

Organic Grand Master

Organic

Posted
  • Author
Posted

Much appreciated, cheers.

  • 2 years later...
Bertdorf3 Apprentice

Bertdorf3

Posted
Posted
Hmm too many letters, here is mine

 
(defun C:LHAT(/ ar cp en hobj lp num rp sset)
 (if (and
(setq lp (getpoint "\nFirst Corner point of selection window >> ")
     rp (getcorner lp "\nOpposite Corner >> "))
(setq sset (ssget "_W" lp rp (list
         (cons 0 "hatch")
         ;; hatch patterns separated by comma
         (cons 2 "ANGLE,DOLMIT,ANSI37,AR-BRELM,AR-RSHKE"); you may exclude this one to grab all hatches
         ))))
 (progn
(setq num (sslength sset))
 (while (> num 0)
   (setq en (ssname sset (setq num (1- num))))
   ;
   (setq hobj (vlax-ename->vla-object en)
  ar (vla-get-area hobj))
(setq cp (trans (cdr (last (entget en))) en 0))
   (command "._mtext"  cp "_h" 2.5 "_j" "_mc" "_w" 0 (rtos ar 2 0) "")
   )
)
   )
 (princ)
 )
(or (vl-load-com)(princ))

 

 

 

Hey FIXO how do I modify this to change the precision of results? I need it to give me measurement to the 100th.

 

THANKS

Bertdorf3 Apprentice

Bertdorf3

Posted
Posted

Ah jeez, if you're still listening... what exactly needs to be removed for it to work with all hatches? I've added ANSI31, wont work. I took off the line in parenthesis... don't work...

THANKS

RedSquirrel Newbie

RedSquirrel

Posted
Posted

i usually place on hatched area mline text, open text window and insert field (field category: objects; field names: object; object type: pick on the drawing, property:area).

if you copy both of them- hatch object and text with field, then paste, stretch new hatch object and use command regen or just save drawing, you'll see, that field will change and showing area of new hatched object.

Bertdorf3 Apprentice

Bertdorf3

Posted
Posted
i usually place on hatched area mline text, open text window and insert field (field category: objects; field names: object; object type: pick on the drawing, property:area).

if you copy both of them- hatch object and text with field, then paste, stretch new hatch object and use command regen or just save drawing, you'll see, that field will change and showing area of new hatched object.

 

 

 

Hey man that works pretty good! Thanks for the tip. Works well, but unfortunately it's not practical for me to do my task that way... I have close to one hundred hatches, three different types, and varying sizes, so the lisp routine is ideal and fast, but I can only get it to function on two of the three hatch patterns.

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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.

×
 Share
Go to topic listing
×
×
  • Create New...