extract area of block to excel

hi, i need lisp or vb to extract area of all block's to excel or notepad with block's number.

my autocad file : [ATTACH]57049

drawing22.dwg

Where are ur blocks ???

Where are ur blocks ???

if OP means block = lot parcel ??

pseudo code

1. collection of texts (lot number)

2. iterate each insertion point, pt

3. if (bpoly pt) valid then get entlast's Area then entdel it,

else highlight text where its lot boundary not closed / outside

4. finally sort the lot numbers with Area then output *.csv etc

amir0914 this would be a good time to learn lisp its a good simple task.

check help or other code for

SSGET to retrieve all the lot text

repeat (sslength ss) for how many text objects

ssname to get each text object

use assoc 10 for insertionpt

Bpoly insertionpt

entlast

then (getvar "area")

write to file a csv

repeat above

Hi,

Here is my attempt in this regard ,try this program and let me know:

(defun c:Test (/ cm ob ss no in sn en ls fl op)
 ;;     Tharwat 22.Feb.2016    ;;
 (princ "\nSelect (m)Texts :")
 (if (setq ob (entlast) ss (ssget '((0 . "*TEXT"))))
   (progn
     (setq cm (getvar 'CMDECHO)
           in (sslength ss)
           no  in)
     (setvar 'CMDECHO 0)
   (repeat in
     (command "_.-boundary" "_none" (cdr (assoc 10 (setq en (entget (ssname ss (setq in (1- in))))))) "")
     (if (and (not (eq ob (setq sn (entlast))))
              (eq "LWPOLYLINE" (cdr (assoc 0 (entget sn))))
              )
       (progn
         (setq ob sn
               ls (cons (list (Clear_Mtext_String (cdr (assoc 1 en))) (rtos (vlax-curve-getarea ob) 2 )) ls)
               )
         (entdel sn)
         )
       )
     )
    (setvar 'CMDECHO cm)
   )
 )

 (if (and ls (setq fl (getfiled "\nSpeficy txt file name :" "" "txt" 1))
          (setq op (open fl "w"))
          )
   (progn
     (write-line "Plot No:\tArea:" op)
     (foreach st ls
       (write-line (strcat (car st) "\t" (cadr st)) op)
       )
     (close op)
     (if (/= no (length ls))
       (alert (strcat "Couldn't create a boundary with a number of Plot(s): [" (itoa (- no (length ls))) "]."))
       )
     )
   )    
 (princ)
 )
  (defun Clear_Mtext_String (String / Text Str)
 ;;    ASMI - sub-function            ;;
 ;; Get string from Formatted Mtext string    ;;
 (setq Text "")
 (while (/= String "")
   (cond ((wcmatch (strcase (setq Str (substr String 1 2))) "\\[\\{}`~]")
          (setq String (substr String 3)
                Text  (strcat Text Str)
          ) 
         ) 
         ((wcmatch (substr String 1 1) "[{}]") (setq String (substr String 2))) 
         ((and (wcmatch (strcase (substr String 1 2)) "\\P") (/= (substr String 3 1) " ")) 
          (setq String (substr String 3)
                Text  (strcat Text " ")
          ) 
         ) 
         ((wcmatch (strcase (substr String 1 2)) "\\[LOP]") (setq String (substr String 3))) 
         ((wcmatch (strcase (substr String 1 2)) "\\[ACFHQTW]")
          (setq String (substr String (+ 2 (vl-string-search ";" String))))
         )
         ((wcmatch (strcase (substr String 1 2)) "\\S")
          (setq Str   (substr String 3 (- (vl-string-search ";" String) 2))
                Text  (strcat Text (vl-string-translate "#^\\" " " Str))
                String (substr String (+ 4 (strlen Str)))
          ) 
          (print Str)
         )
         (T
          (setq Text  (strcat Text (substr String 1 1))
                String (substr String 2)
          ) 
         ) 
   ) 
 ) 
 Text
)   

Tharwat Sir, I have an attachment and drawing, in which I tried to check for some number of random way area, but lisp area and manually search the area did not match.

Please check Highlighted area in excel.

Thank you

Map.dwg

Map.xlsx

Nothing is wrong with codes but if the insertion point of texts is outside its boundary you would have the area of which the insertion point resides.

Tharwat,

I have tried to reduce the "0.1" height of the text, but the number does not match the area.

Please check area following numbers.

194,284,288.

HI Tharwat, thanks for your help. how to automatic add number to empty block and extract area with your lisp?

Drawing333.dwg

What did you do with your thread HERE ?

Why didn't you reply to your thread ?

hi my dear friend.

I am working in the desert in iran. in iran we dont have access to the internet, I have come to the city for online work. and my English is weak. for this reason i can not reply to People.

In addition, it was great : The truth may hurt but it wakes up a dead feeling.

excuse me.

In addition, it was great : The truth may hurt but it wakes up a dead feeling.

 

excuse me.

I wrote that and I felt it might be understood as an offence so I edit the post and remove it.

My attention was to be more active and dynamic which would encourage users to help you as best as they could .

Best of luck and my best regards to Iran.

Tharwat, your program post #5 works for the most part, but it doesn't create the txt file. I tried to determine what may be in error, but to no avail. Using AC2008. Can you offer any suggestions?

Steve

Hi Steve,

Did you receive any error in the command line?

Tharwat, I did not get any error in the command line. Tried some different drawings, same result. Program does produce closed polyline of area adjacent to text insert point as required. at that point it stops and produces a clean Command line. Sort of other programs that are looking for (vl-load-com), but that is not the case, as the (vl-load-com) is within this program if not automatically loaded by users system. I feel at this poing, Excel has nothing to do with the program, as the program is only being asked to produce a txt file. Thanks for your reply.

S

Do you have full control over your drive or the location where you are trying to place the txt file ?

Do you have full control over your drive or the location where you are trying to place the txt file ?

Program stops before it asks for the file name where to put the data. I have full control of all directories except C root. I don't permit any files in C root, they must go to a named directory such as C:\data or C:\dwg etc., selection by me.

Thanks again for your help.

s

As a guess,

(command "_.-boundary" "_none" (cdr (assoc 10 (setq en (entget (ssname ss (setq in (1- in))))))) "")

May be creating REGIONs instead of LWPOLYLINEs.

Lee et.al., program definitely creating LWpolylines when "lot" number is picked. I listed the closed line created, and its a LWpoly. Tharwat may have hit on something, when program is requesting the name of the file to create and write to as being only a plain file name such as "my-answer" as opposed to typing in "C:\data\my-answer". If this is the case, then the file would go to C root which I then need to give "rights" to putting files there and clutter up the C root directory (I guess I'll try that as a last resort).

Thanks gentlemen ! ! !

S

Thank you Lee for the suggestion.

Actually you are not reaching the codes where it should ask you to specify the txt file name because the list is empty which is represented by the variable 'ls'

Try this modification;

EDIT: codes edited to convert the entity to vla-object

(defun c:Test (/ cm ob ss no in sn en ls fl op)
 ;;     Tharwat 29.Mar.2016    ;;
 (princ "\nSelect (m)Texts :")
 (if (setq ob (entlast) ss (ssget '((0 . "*TEXT"))))
   (progn
     (setq cm (getvar 'CMDECHO)
           in (sslength ss)
           no  in)
     (setvar 'CMDECHO 0)
   (repeat in
     (command "_.-boundary" "_A" "_O" "_Region" "" "_none" (cdr (assoc 10 (setq en (entget (ssname ss (setq in (1- in))))))) "")
     (if (and (not (eq ob (setq sn (entlast))))
              (eq "REGION" (cdr (assoc 0 (entget sn))))
              )
       (progn
         (setq ob sn
               ls (cons (list (Clear_Mtext_String (cdr (assoc 1 en))) (rtos (vla-get-area (vlax-ename->vla-object ob)) 2 )) ls)
               )
         (entdel sn)
         )
       )
     )
    (setvar 'CMDECHO cm)
   )
   (princ "\nNo texts selected !")
 )

 (if (and ls (setq fl (getfiled "\nSpeficy txt file name :" "" "txt" 1))
          (setq op (open fl "w"))
          )
   (progn
     (write-line "Plot No:\tArea:" op)
     (foreach st ls
       (write-line (strcat (car st) "\t" (cadr st)) op)
       )
     (close op)
     (if (/= no (length ls))
       (alert (strcat "Couldn't create a boundary with a number of Plot(s): [" (itoa (- no (length ls))) "]."))
       )
     )
   )    
 (princ)
 )
  (defun Clear_Mtext_String (String / Text Str)
 ;;    ASMI - sub-function            ;;
 ;; Get string from Formatted Mtext string    ;;
 (setq Text "")
 (while (/= String "")
   (cond ((wcmatch (strcase (setq Str (substr String 1 2))) "\\[\\{}`~]")
          (setq String (substr String 3)
                Text  (strcat Text Str)
          ) 
         ) 
         ((wcmatch (substr String 1 1) "[{}]") (setq String (substr String 2))) 
         ((and (wcmatch (strcase (substr String 1 2)) "\\P") (/= (substr String 3 1) " ")) 
          (setq String (substr String 3)
                Text  (strcat Text " ")
          ) 
         ) 
         ((wcmatch (strcase (substr String 1 2)) "\\[LOP]") (setq String (substr String 3))) 
         ((wcmatch (strcase (substr String 1 2)) "\\[ACFHQTW]")
          (setq String (substr String (+ 2 (vl-string-search ";" String))))
         )
         ((wcmatch (strcase (substr String 1 2)) "\\S")
          (setq Str   (substr String 3 (- (vl-string-search ";" String) 2))
                Text  (strcat Text (vl-string-translate "#^\\" " " Str))
                String (substr String (+ 4 (strlen Str)))
          ) 
          (print Str)
         )
         (T
          (setq Text  (strcat Text (substr String 1 1))
                String (substr String 2)
          ) 
         ) 
   ) 
 ) 
 Text
)(vl-load-com)