lisp for area

[harshad]

hi all i want a lisp for area ,if i select one ,circle, rec , poly, ect..

lisp want to put area or perimeter on drawing see exzample

lisp should ask for text hight and area or perimeter

 

 

please help me

sample.pdf

[fixo]

Give this a try

 

~'J'~

 

[/c(defun C:alb (/ acsp adoc ar axss hgt maxp minp obj p1 p2 pc ss txt)

(vl-load-com)
(setq	adoc (vla-get-activedocument
      (vlax-get-acad-object)
    )
)
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
(setq acsp (vla-get-paperspace adoc))
(setq acsp (vla-get-modelspace adoc))
)
(vla-startundomark (vla-get-activedocument
                      (vlax-get-acad-object)))
(initget 7)
(setq hgt (getreal "\nEnter text height: "))
 
(prompt "\nSelect objects on screen to add area label")
(if (setq ss (ssget))
(progn

   (setq axss (vla-get-activeselectionset adoc))
(vlax-for obj axss
(if (not
(vl-catch-all-error-p
 (setq
   ar (vl-catch-all-apply
          (function (lambda()
                        (vlax-curve-getarea obj)))))))
(progn
(setq txt (strcat "Area = " (rtos ar 2 2)))
(vla-getboundingbox obj 'minp 'maxp)
(setq p1 (vlax-safearray->list minp)
 p2 (vlax-safearray->list maxp)
 pc (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2)
 )
(vlax-invoke acsp 'Addtext txt pc hgt)
)
 )
)
)
)
(vla-endundomark (vla-get-activedocument
                      (vlax-get-acad-object)))
   (princ)
   )
(princ "\nType ALB to label objects with area text")
(princ)

[harshad]

fatty this is good and work fine

 

 

but lisp ask me for perimiter also

make like this i m thankful to u

 

harshad:)

[fixo]

Please attach the picture where you

want to put perimeter text

Do you want to put them on the

second line below the area text or

somewhere else?

 

~'J'~

[fixo]

Try edited version

 

(defun C:alb (/ acsp adoc ar axss hgt maxp minp obj p1 p2 pc1 pc2 per
               ss txt1 txt2)

(vl-load-com)
(setq	adoc (vla-get-activedocument
      (vlax-get-acad-object)
    )
)
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
(setq acsp (vla-get-paperspace adoc))
(setq acsp (vla-get-modelspace adoc))
)
(vla-startundomark (vla-get-activedocument
                      (vlax-get-acad-object)))
(initget 7)
(setq hgt (getreal "\n  Enter text height: "))
 
(prompt "\n  Select objects on screen to add area label")
(if (setq ss (ssget))
(progn

   (setq axss (vla-get-activeselectionset adoc))
(vlax-for obj axss
(if
(and
(not
(vl-catch-all-error-p
 (setq
   ar (vl-catch-all-apply
          (function (lambda()
                        (vlax-curve-getarea obj)))))))
(not
(vl-catch-all-error-p
   (setq
   per (vl-catch-all-apply
          (function (lambda()
                        (vlax-curve-getdistatparam obj
                             (vlax-curve-getendparam obj)))))))))
(progn
(setq txt1 (strcat "Area = " (rtos ar 2 2)))
(setq txt2 (strcat "Perimeter = " (rtos per 2 2)))
(vla-getboundingbox obj 'minp 'maxp)
(setq p1 (vlax-safearray->list minp)
 p2 (vlax-safearray->list maxp)
 pc1 (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2)
 pc2 (mapcar '- pc1 (list 0 (* hgt 1.5) 0))    
     
 )
(vlax-invoke acsp 'Addtext txt1 pc1 hgt)
(vlax-invoke acsp 'Addtext txt2 pc2 hgt)
)
 )
)
)
)
(vla-endundomark (vla-get-activedocument
                      (vlax-get-acad-object)))
   (princ)
   )
(princ "\n   Type ALB to label objects with area and perimeter text")
(princ)
(C:alb)

 

~'J'~

[harshad]

thats fine fatty

thank u very much:)

[fixo]

thats fine fatty

thank u very much:)

You are welcome

Cheers

 

~'J'~

[Guite]

So I copied the above lsp and used it after slight modifications, but ran into problems in certain situations.

 

Please look at the attached drawing:

(1) is from a drawing drawn in rotated UCS and (2) is a boundary generated in another drawing. The boundary has some co-linear lines segmented. If the segments are replaced with a single line then the code works. As it is, this boundary does not generate any error message but (1) does as below:

Enter text:

Command: Area= 226.52 Unknown command "AREA= 226.52". Press F1...

Enter text:

Command: Perimeter= 65.14 Unknown command "PERIMETER= 65.14". Press F1...

I am not exactly new to AutoLISP but neither am I a pro at it. Can someone please trouble shoot?

 

The modifications I have done to the code is to generate text height by picking on an existing text instead of typing and have text centre aligned. Relevant portion of text height pick is:

(setQ txts (entsel "\nSelect TEXT to match height: "))

(setQ txt1 (entget (car txts)))

(setQ txht (cdr (assoc 40 txt1)))

 

In place of:

(initget 7)

(setq hgt (getreal "\n Enter text height: "))

Please note some variables have been changed. I am yet to include error check on the text pick, which I hope to learn sooner rather than later.

 

Thanks,

Guite

 

Edit: The test file Test1.dwg is 1mb, so I copied its contents to a new (blank) file, named it Test2.dwg and attached. Now (1) is working but (2) still does not work.

Test2.dwg

[Guite]

Edit: Please ignore.

[fixo]

I'm so sorry

I can see your problem just later

Now I'm very busy with my work

 

~'J'~

[Guite]

Thanks Fatty, take your time. If it helps, here is my modified version of your code:

(defun C:ab (/ acsp adoc ar axss txht maxp minp obj p1 p2 pc1 pc2 per
               ss txts txt1 txt2)

(vl-load-com)
(setq    adoc (vla-get-activedocument
      (vlax-get-acad-object)
    )
)
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
(setq acsp (vla-get-paperspace adoc))
(setq acsp (vla-get-modelspace adoc))
)
(vla-startundomark (vla-get-activedocument
                      (vlax-get-acad-object)))
(setQ txts (entsel "\nSelect TEXT to match height: "))
 (setQ txt1 (entget (car txts)))
(setQ txht (cdr (assoc 40 txt1)))
 
(prompt "\n  Select OBJECTS on screen to add area label")
(if (setq ss (ssget))
(progn

   (setq axss (vla-get-activeselectionset adoc))
(vlax-for obj axss
(if
(and
(not
(vl-catch-all-error-p
 (setq
   ar (vl-catch-all-apply
          (function (lambda()
                        (vlax-curve-getarea obj)))))))
(not
(vl-catch-all-error-p
   (setq
   per (vl-catch-all-apply
          (function (lambda()
                        (vlax-curve-getdistatparam obj
                             (vlax-curve-getendparam obj)))))))))

(progn
(setq txt1 (strcat "Area= " (rtos ar 2 2)))
(setq txt2 (strcat "Perimeter= " (rtos per 2 2)))
(vla-getboundingbox obj 'minp 'maxp)
(setq p1 (vlax-safearray->list minp)
     p2 (vlax-safearray->list maxp)
     pc1 (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2)
     pc2 (mapcar '- pc1 (list 0 (* txht 1.5) 0))
     
 )
(command "text" "c" pc1 txht "" txt1)
(command "text" "c" pc2 txht "" txt2)
)
 )
)
)
)
(vla-endundomark (vla-get-activedocument
                      (vlax-get-acad-object)))
   (princ)

   )
(princ "\n   Type AB to label objects with area and perimeter text")
(princ)
(C:ab)

Guite

[fixo]

Glad you solved it

And, thanks, you saved my time

Happy computing

 

~'J'~

[Guite]

Fatty,

No, it's not solved. Quote form my first post:

So I copied the above lsp and used it after slight modifications, but ran into problems in certain situations.

....

The modifications I have done to the code is to generate text height by picking on an existing text instead of typing and have text centre aligned.

The code I have posted above is my modified version, it does not work on graphic (1) and graphic (2) of my test file. (Please note that the test file I have posted is not the one I am using, which is 1mb size, but same content, apparently).

 

Interestingly, your edited version works on graphic (1) but not on graphic (2). So if yours work on (1) and not (2) but mine does not work on both, can some of the changes I have made to the code be responsible, for instance, the line for text insertion and alignment?

 

Cheers,

Guite

[fixo]

Send me test message private,

then I'll give you my address to

send your file

I want to see where is a problem with it

 

~'J'~

[Guite]

Oops, that will have to wait till Monday because the file is in my office PC.

[fixo]

Ok, still waiting for

 

~'J'~

[Butch]

Hey Fixo how R U? :-)

Can you make this lisp divide the area value by lets say 100.

So instead of saying 1245.00 the text will say 12.45.

Can this be done?

Many thanx my friend!

[fixo]

Hey Fixo how R U? :-)

Can you make this lisp divide the area value by lets say 100.

So instead of saying 1245.00 the text will say 12.45.

Can this be done?

Many thanx my friend!

 

Hi,

Try to change these lines:

(setq txt1 (strcat "Area= " (rtos ar 2 2)))
(setq txt2 (strcat "Perimeter= " (rtos per 2 2)))

on

(setq txt1 (strcat "Area= " (rtos (/ ar 100) 2 2)))
(setq txt2 (strcat "Perimeter= " (rtos (/ per 10) 2 2)))

 

HTH

 

~'J'~