Basic LISP help required

I have a repetitive task involving inserting room areas into an attribute block. Currently I am using standard 'area' command and counting back six places from the decimal point, mentally noting result and inserting it into the block, this becomes tiring and error prone over a long period. I am sure there must be an easier way but try as I might I seem unable to master creating or modifying even a simple routine that works successfully.

I am running Autocad 2008 (decimal units, 1 unit represents 1 millimetre)

Routine required as follows:-

Select polyline (by manual picking)

Calculate area (sq millimetres)

Convert to sq metres (divide by 100,000)

Reduce result to two decimal places

Copy to clipboard

Manually select attribute block

Paste sq. metre value into attribute

and repeat with next polyline etc

Initially I tried to produce a routine which would let me select polyline then select block (it sits within polyline boundary) and have the area inserted into the attribute but struggled with the programming and opted for the easier alternative above.

Can anyone please offer advice on simplest way to do this?

Regards

Could you post a sample code of what you have so far?

All of the above should be able to be achieved via lisp

Jammie

Hopefully I have attached two files for your info

parea.lsp

Floor plan.dwg

I wrote this a while back for another thread, uses FIELDS:

(defun c:GetAreas (/ *error* lst->str DOC IDS PT SS UFLAG)
 (vl-load-com)
 ;; Lee Mac  ~  18.03.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun GetObjectID (obj)
   (setq util (cond (util) ((vla-get-Utility
                              (vla-get-ActiveDocument (vlax-get-acad-object))))))
   
   (if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
     (vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
     (itoa (vla-get-Objectid obj))))     

 (defun lst->str (lst d1 d2)
   (if (cdr lst)
     (strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
     (strcat d1 (car lst))))

 (princ "\nSelect Objects to Retrieve Total Area... ")
 (if (and (ssget '((0 . "ARC,CIRCLE,ELLIPE,HATCH,*POLYLINE,REGION")))
          (setq pt (getpoint "\nPick Point for Field: ")))
   (progn
     (setq uFlag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object))))))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (setq Ids (cons (GetObjectID obj) Ids)))
     (vla-delete ss)

     (vla-AddMText

       (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
               (eq :vlax-true   (vla-get-MSpace doc)))
         (vla-get-ModelSpace doc)
         (vla-get-PaperSpace doc))

       (vlax-3D-point pt) 0.

       (if (= 1 (length Ids))
         (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids) ">%).Area \\f \"%lu6%qf1\">%")
         (strcat "%<\\AcExpr" (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId " ">%).Area >% +")
                 ">%).Area >% \\f \"%lu6%qf1\">%")))

     (setq uFlag (vla-EndUndomark doc))))

 (princ))

Or for placing into existing text/attribs:

(defun c:GetAreas (/ *error* lst->str GetObjectID DOC ENT IDS SS UFLAG UTIL)
 (vl-load-com)
 ;; Lee Mac  ~  18.03.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun GetObjectID (obj)
   (setq util (cond (util) ((vla-get-Utility
                              (vla-get-ActiveDocument (vlax-get-acad-object))))))
   
   (if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
     (vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
     (itoa (vla-get-Objectid obj))))     

 (defun lst->str (lst d1 d2)
   (if (cdr lst)
     (strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
     (strcat d1 (car lst))))

 (princ "\nSelect Objects to Retrieve Total Area... ")
 (if (and (ssget '((0 . "ARC,CIRCLE,ELLIPE,HATCH,*POLYLINE,REGION")))
          (setq ent (car (nentsel "\nSelect Text, MText or Attrib to Place: ")))
          (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT,ATTRIB"))                          
   (progn
     (setq uFlag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object))))))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (setq Ids (cons (GetObjectID obj) Ids)))
     (vla-delete ss)

     (vla-put-TextString
       (vlax-ename->vla-object ent)
       (if (= 1 (length Ids))
         (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids) ">%).Area \\f \"%lu6%qf1\">%")
         (strcat "%<\\AcExpr" (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId " ">%).Area >% +")
                 ">%).Area >% \\f \"%lu6%qf1\">%")))

     (vla-regen doc acActiveViewport)
     (setq uFlag (vla-EndUndomark doc))))

 (princ))

Thank you so much for this prompt response. I have been messing about with this for ages without any success. The second routine you sent for loading the area into the attribute works perfectly lacking only the conversion from sq millimetres to sq metres.

No worries Frank

(defun c:GetAreas (/ *error* lst->str GetObjectID DOC ENT IDS SS UFLAG UTIL)
 (vl-load-com)
 ;; Lee Mac  ~  18.03.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun GetObjectID (obj)
   (setq util (cond (util) ((vla-get-Utility
                              (vla-get-ActiveDocument (vlax-get-acad-object))))))
   
   (if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
     (vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
     (itoa (vla-get-Objectid obj))))     

 (defun lst->str (lst d1 d2)
   (if (cdr lst)
     (strcat d1 (car lst) d2 (lst->str (cdr lst) d1 d2))
     (strcat d1 (car lst))))

 (princ "\nSelect Objects to Retrieve Total Area... ")
 (if (and (ssget '((0 . "ARC,CIRCLE,ELLIPE,HATCH,*POLYLINE,REGION")))
          (setq ent (car (nentsel "\nSelect Text, MText or Attrib to Place: ")))
          (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT,ATTRIB"))                          
   (progn
     (setq uFlag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object))))))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (setq Ids (cons (GetObjectID obj) Ids)))
     (vla-delete ss)

     (vla-put-TextString
       (vlax-ename->vla-object ent)
       (if (= 1 (length Ids))
         (strcat "%<\\AcObjProp Object(%<\\_ObjId " (car Ids) ">%).Area \\f \"%lu6%qf1%ct8[1e-6]\">%")
         (strcat "%<\\AcExpr" (lst->str Ids " %<\\AcObjProp Object(%<\\_ObjId " ">%).Area >% +")
                 ">%).Area >% \\f \"%lu6%qf1%ct8[1e-6]\">%")))

     (vla-regen doc acActiveViewport)
     (setq uFlag (vla-EndUndomark doc))))

 (princ))

It's perfect now, I've three thousand room attributes to insert on building floor layouts, this will make it so much easier, can't thank you enough

Regards

Frank

Happy to help Frank

Could you post a sample code of what you have so far?

 

All of the above should be able to be achieved via lisp

Jammie

I'm pleased to report a solution has been found, thank you for your kind offer of assistance

Regards

Frank

Happy to help Frank

Hi. this is kasra.

I 'm using a routine for calculating area of a closed region in SQ. meters and type it into that region.like this (S1=100.00 m2).

My problem :

"the suffix "m2" is undesired for me. It would be better if it's square sign, would typed with superscript format".

Is it possible ?

What commands or functions do you suggest for this purpose and how should the commands or functions be used?

note: I used "text" command with my routine.

Hi. this is kasra.

I 'm using a routine for calculating area of a closed region in SQ. meters and type it into that region.like this (S1=100.00 m2).

My problem :

"the suffix "m2" is undesired for me. It would be better if it's square sign, would typed with superscript format".

Is it possible ?

What commands or functions do you suggest for this purpose and how should the commands or functions be used?

note: I used "text" command with my routine.

"m²"

................

yes. is there any solution?

Type

m\U+00B2

Or for MText, for general SubScript/SuperScipt, the formatting code is:

m{\H0.7x;\S^2;}

m{\H0.7x;\S2^;}

Thanks a lot lee.

It works properly with many fontstyles. But with the fontstyle "txt.shx", it types "m?".

However my purpose is provided with code you introduced.

Again thanks.

You're welcome

It's work perfect. Thanks. I'd looking for that long time.

You're welcome Sevdo, happy to help

You're welcome Sevdo, happy to help

I have no still words to thank you for that lisp Lee. I use it all the time. Is it insolent to ask you for do this lisp just select one polyline (if I select second third ... it sums them - whitch is perfect for some cases) and to not hit enter to confirming it - just the lisp ask me to select the TEXT, attrib. and etc.

Thanks in advance

You're welcome

Try this:

(defun c:GetArea (/ *error* GetObjectID DOC ENT IDS OBJ SS UFLAG)
 (vl-load-com)
 ;; Lee Mac  ~  18.03.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun GetObjectID (obj / util)
   (setq util (cond (util) ((vla-get-Utility
                              (vla-get-ActiveDocument (vlax-get-acad-object))))))
   
   (if (vl-string-search "X64" (strcase (getvar 'PLATFORM)))
     (vlax-invoke-method util 'GetObjectIdString obj :vlax-false)
     (itoa (vla-get-Objectid obj))))

 (while
   (progn
     (setq obj (car (nentsel "\nSelect Object to Retrieve Area: ")))

     (cond (  (eq 'ENAME (type obj))

              (if (wcmatch (cdr (assoc 0 (entget obj)))
                    "ARC,CIRCLE,ELLIPE,HATCH,*POLYLINE,REGION")
                (if (and (setq ent (car (nentsel "\nSelect Text, MText or Attrib to Place: ")))
                         (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT,ATTRIB"))
                  (progn
                    (setq uFlag (not (vla-StartUndoMark
                                       (setq doc (vla-get-ActiveDocument
                                                   (vlax-get-acad-object))))))
                    
                    (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
                      (setq Ids (cons (GetObjectID obj) Ids)))
                    (vla-delete ss)
                    
                    (vla-put-TextString (vlax-ename->vla-object ent)
                      (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                        (GetObjectID (vlax-ename->vla-object obj)) ">%).Area \\f \"%lu6%qf1\">%"))
                    
                    (vla-regen doc acActiveViewport)
                    (setq uFlag (vla-EndUndomark doc))))

                (princ "\n** Invalid Object Selected **"))))))
 (princ))