Jump to content
prodromosm

Help with multy area lisp

Recommended Posts

prodromosm

Hi am using this code to calculate and insert area text in multyple polygons. I have a problem with the annotation text size.

1) I want in paper space the text size 2.5 and in model space if tor example the  annotation scale set to 1:200 the size of the text be 0.5.

2) I want the insert text justify center

Can any one help ?

 

;;; Calculate area of closed polyline and place text in Sq.m in center of closed area
;;; Modified by Igal Aberbuh 2016
(defun C:at (/ acsp adoc ar axss hgt maxp minp obj p1 p2 pc ss txt)
(COMMAND "_layer" "_m" "_Area" "_c" "41""" "")
(command "_.-style" "_Multy Area" "arial.ttf" "_annotative" "_yes" "_no" 2.5 1.0 0.0 "_no" "_no" "_no")
(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 textsize 1)
;(setvar 'textsize
;(cond ((getdist (strcat "\nSpecify Area text height by two points on screen : ")))
;((getvar 'textsize))
;)
;)

(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)"m²"))
(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 (getvar 'textsize))
)
)
)
)
)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object)))
;change layer to 0
(mapcar 'setvar '(clayer cecolor celtype celweight) (list "0" "BYLAYER" "BYLAYER" -1))
(princ)
)

Thanks

Share this post


Link to post
Share on other sites
prodromosm

Any ideas?

Share this post


Link to post
Share on other sites
devitg

Please upload your-real-sample.dwg with such sample , as in in Model as in Paper

  • Like 1

Share this post


Link to post
Share on other sites
BIGAL

A couple of suggestions

 

(setq ss (ssget)) add a filter to select only "LWPOLYLINE"

 

Set your text style to one which is annotative (getvar 'textstyle) check if what you want

 

Some one will correct me but not sure if using VL can add "center" rather have to amend the text object after creation. If use (command yes "c" is an option.

 

;not tested
(setq obj (vlax-invoke acsp 'Addtext txt pc (getvar 'textsize)))
(vla-put-alignment obj 1)

 

Share this post


Link to post
Share on other sites
prodromosm

Hi BiGAL. I cant figure it out. The problem is in  text size and

 

Quote

(setq ss (ssget)) add a filter to select only "LWPOLYLINE"

 

Edited by prodromosm

Share this post


Link to post
Share on other sites
prodromosm

I add the filter to select polylines and automatic insert the Area text. Now i need help with the text size and the justification center

;;; Calculate area of closed polyline and place text in Sq.m in center of closed area
;;; Modified by Igal Aberbuh 2016
(defun C:at (/ acsp adoc ar axss hgt maxp minp obj p1 p2 pc ss txt)
(COMMAND "_layer" "_m" "_Area" "_c" "41""" "")
(command "_.-style" "_Multy Area" "arial.ttf" "_annotative" "_yes" "_no" 2.5 1.0 0.0 "_no" "_no" "_no")
(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 textsize 1)
;(setvar 'textsize
;(cond ((getdist (strcat "\nSpecify Area text height by two points on screen : ")))
;((getvar 'textsize))
;)
;)

(prompt "\nSelect objects on screen to add area label")
(if (setq ss (ssget "X" (list (cons 0 "*POLYLINE"))))
(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)"m²"))
(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 (getvar 'textsize))
)
)
)
)
)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object)))
;change layer to 0
(mapcar 'setvar '(clayer cecolor celtype celweight) (list "0" "BYLAYER" "BYLAYER" -1))
(princ)
)

Thanks

Share this post


Link to post
Share on other sites
dlanorh

Try the attached. I've adapted one of my older routines to work as required, but it inserts MText not text.

PolyArea.LSP

Share this post


Link to post
Share on other sites
prodromosm

Thank you dlanorh

Share this post


Link to post
Share on other sites
BIGAL

I posted the answer for "center" (vla-put-alignment obj x) the x changes the alignment I would have to figure out the "Center" value.

Share this post


Link to post
Share on other sites
prodromosm

Thanks BIGAL

Share this post


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.   Paste as plain text instead

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