LISP needed for closed areas
Hello JB-T and welcome to the Autodesk Community!
Quick and dirty, and as a strating point...
(vl-load-com)
(defun c:demo ( / area ent lst obj pt)
(if (and (setq lst (entlast))
(setq pt (getpoint "\nSpecify internal point: "))
(vl-cmdf "_.-boundary" pt "")
(setq ent (entlast))
(not (eq lst ent))
)
(progn
(setq obj (vlax-ename->vla-object ent)
area (vla-get-area obj)
)
(entmake (list
'(0 . "TEXT")
(cons 10 pt)
(cons 40 (getvar 'TEXTSIZE))
(cons 1 (strcat (rtos area 2 2) " m2"))
)
)
)
)
(princ)
)
Hope this helps,
Henrique
@JB-T wrote:
Hello!
This little script you gave me is truly awesome Henrique! Thanks alot!
I was wondering how we could simply modify this script so that the routine could stay in the command after I clicked in the first closed area, ready for another click. With this modification I would be able to "click-mouse pan-click [...]" without having to press enter each time before clicking.
Thanks alot for your help it is really appreciate!
You're welcome, JB-T
Glad I could help!
Code revised...
(vl-load-com)
(defun c:demo (/ area ent lst obj pt)
(while (and (setq lst (entlast))
(setq pt (getpoint "\nSpecify internal point: "))
(vl-cmdf "_.-boundary" pt "")
(setq ent (entlast))
(not (eq lst ent))
)
(setq obj (vlax-ename->vla-object ent)
area (vla-get-area obj)
)
(entmake (list
'(0 . "TEXT")
(cons 10 (trans pt 1 0))
(cons 40 (getvar 'TEXTSIZE))
(cons 1 (strcat (rtos area 2 2) " m2"))
(cons 50 (angle '(0.0 0.0) (getvar 'UCSXDIR)))
)
)
)
(princ)
)
Henrique
Something like this, perhaps...
(vl-load-com)
(defun c:demo (/ area ent flag lst obj pt tmpH)
(if (or (not *Hscl*) (/= (type *Hscl*) 'REAL))
(setq *Hscl* (getvar 'TEXTSIZE))
)
(initget 6)
(setq tmpH (getreal (strcat "\nSpecify Text Height: <" (rtos *Hscl*) ">: ")))
(if (/= tmpH nil)
(setq *Hscl* tmpH)
)
(while (null flag)
(cond ((setq pt (getpoint "\nSpecify internal point <exit>: "))
(if (and (setq lst (entlast))
(vl-cmdf "_.-boundary" pt "")
(setq ent (entlast))
(not (eq lst ent))
)
(progn
(setq obj (vlax-ename->vla-object ent)
area (vla-get-area obj)
)
(entmake (list
'(0 . "TEXT")
(cons 10 (trans pt 1 0))
(cons 40 *Hscl*)
(cons 1 (strcat (rtos area 2 2) " m2"))
(cons 50 (angle '(0.0 0.0) (getvar 'UCSXDIR)))
)
)
)
)
)
(T
(setq flag T)
)
)
)
(princ)
)
Hope this helps,
Henrique
Hi JBT,
you're welcome!
I'm with an old laptop and a very old AutoCAD version, so I can't test 'the Lasso selection method becomes enabled', only next week...but I can not understand why it becomes enabled...
(vl-load-com)
(defun c:demo (/ *error* area ent lst obj osm pt tmpH)
(defun *error* (msg)
(if osm
(setvar 'OSMODE osm)
)
(cond ((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\n** Error: " msg " ** ")))
)
(princ)
)
(setq osm (getvar 'OSMODE))
(setvar 'OSMODE (+ osm 16384))
(if (or (not *Hscl*) (/= (type *Hscl*) 'REAL))
(setq *Hscl* (getvar 'TEXTSIZE))
)
(initget 6)
(setq tmpH (getreal (strcat "\nSpecify Text Height: <" (rtos *Hscl*) ">: ")))
(if (/= tmpH nil)
(setq *Hscl* tmpH)
)
(while (and (setq lst (entlast))
(setq pt (getpoint "\nSpecify internal point: "))
(vl-cmdf "_.-boundary" pt "")
(setq ent (entlast))
(not (eq lst ent))
)
(setq obj (vlax-ename->vla-object ent)
area (vla-get-area obj)
)
(entmake (list
'(0 . "TEXT")
'(10 0.0 0.0 0.0)
(cons 40 *Hscl*)
(cons 1 (strcat (rtos area 2 2) " m2"))
(cons 50 (angle '(0.0 0.0) (getvar 'UCSXDIR)))
'(72 . 1)
(cons 11 (trans pt 1 0))
'(73 . 2)
)
)
)
(*error* nil)
(princ)
)
The text is justified to 'middle center', if you need to justify to 'center', change the (73 . 2) to (73 . 0)
To remove the "m2" of the annotation, just change the (cons 1 (strcat (rtos area 2 2) " m2")) to (cons 1 (rtos area 2 2))
To change the point to a comma, change the (cons 1 (rtos area 2 2)) to (cons 1 (vl-string-subst "," "." (rtos area 2 2)))
Hope this helps,
Henrique
Look into what the system variable OSOPTIONS current value when the program is not showing the error. then include that on the routine, see if that error goes away.
(if osm
(mapcar
'setvar
'("OSMODE" "OSOPTIONS")
(list osm oso )
)
)
....
(setq osm (getvar 'OSMODE)
oso (getvar 'OSOPTIONS))
(setvar 'OSMODE (+ osm 16384))
(setvar 'OSOPTIONS 4) ;<-- your preferred value
...
Not tested it as i can't seem to reproduce that same error on my pc.
HTH
@Ranjit_Singh wrote:
....the osmode variable is higher than 16384, it means 2D object snap is off) ...
That makes a whole lot of sense.
