steel quantity lisp

[ekolman2003]

re-bar quantity lisp working dd command. firstly, u select "for example: 11f8/30"

and then u select "for example: L=250 cm" lenght.

u select all rebar like this. and then press enter.

it will be an excel file.

the lisp write all datas side by side. for example: 22f8/30 L:250 11f8/20 L:40

I want this 22f8/30 L:250 . please help.

11f8/20 L:40

1-) Statik Proje.dwg

re-bar quantity.lsp

[pyrzms]

http://www.cadtutor.net/forum/showthread.php?84023-Combine-text-strings read this thread.

[ekolman2003]

thanks but that lisp is different

[ymg3]

ekolman,

 

Here is something that works more or less in your case.

 

We find the bounding box of the bar text then send creates a fence selection

from the center of the bb to the left of it.

 

We sort the resulting selection set on distance from the bounding box.

 

However you managed to have some bar with distance to the right or on top

of each other. So please correct these before using.

 

Entity that cannot be matched are highlightred with a rectangle around them.

 

The matched entities are sent to a CSV file.

 

No amount of Lisp will replace a well drafted drawing. The way your annotations are done, makes it difficult even for a human to figure the dimension of the bars.

 

(defun c:test (/ dir dist en en2 ent ent2 fh fname f1 f2 foundl i j
                mn mx nomatch p1 p2 searchlen ss ss2)

  
 ;; File is opened in Append Mode                                            ;
  
 (setq fname (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) ".csv")
          fh (open fname "a"))
  
 (setq  scrsize   (getvar 'SCREENSIZE)
        ratio     (/ (car scrsize) (cadr scrsize))
        searchlen (* (getvar 'VIEWSIZE) ratio) ; Length of Selection Fence   ;
        nomatch 0 ; Number of Items with no matched length                   ;
 )
  
 ;; Selecting All Text with Character ASCII 131                              ;
 (if (setq ss (ssget "_X" '((0 . "TEXT") (1 . "#*`ƒ#*`/##"))))
    (progn
       (repeat (setq i  (sslength ss))
          (setq en (ssname ss (setq i (1- i)))
                ent (entget en)
                dir (cdr (assoc 50 ent))
          )
          (vla-getboundingbox (vlax-ename->vla-object en) 'mn 'mx)
          (setq p1 (vlax-safearray->list mn)
                p2 (vlax-safearray->list mx)
          )
       ;; First point of fence is midpoint of Bar Description.               ;
          (setq f1 (list (/ (+ (car p2) (car p1)) 2.) (/ (+ (cadr p2) (cadr p1)) 2.))
                f2 (polar f1 dir searchlen)
          ) 
          (if (setq ss2 (ssget "_F" (list f1 f2)  '((0 . "TEXT") (1 . "L=#*"))))
             (progn
                (setq foundl nil)
                (repeat (setq j  (sslength ss2))
                   (setq en2  (ssname ss2 (setq j (1- j)))
                         ent2 (entget en2)
                         dist (distance f1 (cdr (assoc 10 ent2)))
                       foundl (cons (list dist (cdr (assoc 1 ent2))) foundl)                 
                   )
                   (setq foundl (vl-sort foundl (function (lambda (a b) (< (car  a) (car  b))))))
                   (write-line (strcat (cdr (assoc 1 ent)) ", "  (cadr (car foundl))) fh)
                )           
             )
             ;; If we did nod not find put a rectangle around the entity.    ;
            (progn 
               (vl-cmdf "_RECTANGLE" p1 p2)
               (setq nomatch (1+ nomatch))
            )      
          )
       )   
    )
 )
 (princ (strcat "File: " fname " has been created."))                                               
 (close fh)
 (if (> nomatch 0) (alert (strcat (itoa nomatch) " Bars could not be matched.")))
 (princ)
)

 

ymg

[ekolman2003]

thanks a lot ymg. u are a perfect man:)) its excellent code. can we add "repair" this code like rebar.lisp?

[ymg3]

Ekolman,

 

Yes you can add it.

 

Except as I told you, there is a possibility that some annotations could be mixed up

in the case where the length is not in the same direction as the bar annotations.

 

ymg

[ekolman2003]

ymg how we can do rebar quantity like this=? I dont know code language sorry man.

beam.dwg

[ekolman2003]

test code not work like this rebar text ; 2ƒ14 L=150 or 2x2ƒ12 L=200

[fixo]

change filter like this:

(setq ss (ssget "_X" '((0 . "TEXT") (1 . "#*\\U+0130#*`/##"))))

ymg beat me for it

[ekolman2003]

(defun c:test (/ dir dist en en2 ent ent2 fh fname f1 f2 foundl i j

mn mx nomatch p1 p2 searchlen ss ss2)

 

;; File is opened in Append Mode ;

 

(setq fname (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) ".csv")

fh (open fname "a"))

 

(setq scrsize (getvar 'SCREENSIZE)

ratio (/ (car scrsize) (cadr scrsize))

searchlen (* (getvar 'VIEWSIZE) ratio) ; Length of Selection Fence ;

nomatch 0 ; Number of Items with no matched length ;

)

 

;; Selecting All Text with Character ASCII 131 ;

(if (setq ss (ssget "_X" '((0 . "TEXT") (1 . "#*\\U+0130#*`/##"))))

(progn

(repeat (setq i (sslength ss))

(setq en (ssname ss (setq i (1- i)))

ent (entget en)

dir (cdr (assoc 50 ent))

)

(vla-getboundingbox (vlax-ename->vla-object en) 'mn 'mx)

(setq p1 (vlax-safearray->list mn)

p2 (vlax-safearray->list mx)

)

;; First point of fence is midpoint of Bar Description. ;

(setq f1 (list (/ (+ (car p2) (car p1)) 2.) (/ (+ (cadr p2) (cadr p1)) 2.))

f2 (polar f1 dir searchlen)

)

(if (setq ss2 (ssget "_F" (list f1 f2) '((0 . "TEXT") (1 . "L=#*"))))

(progn

(setq foundl nil)

(repeat (setq j (sslength ss2))

(setq en2 (ssname ss2 (setq j (1- j)))

ent2 (entget en2)

dist (distance f1 (cdr (assoc 10 ent2)))

foundl (cons (list dist (cdr (assoc 1 ent2))) foundl)

)

(setq foundl (vl-sort foundl (function (lambda (a b) (

(write-line (strcat (cdr (assoc 1 ent)) ", " (cadr (car foundl))) fh)

)

)

;; If we did nod not find put a rectangle around the entity. ;

(progn

(vl-cmdf "_RECTANGLE" p1 p2)

(setq nomatch (1+ nomatch))

)

)

)

)

)

(princ (strcat "File: " fname " has been created."))

(close fh)

(if (> nomatch 0) (alert (strcat (itoa nomatch) " Bars could not be matched.")))

(princ)

)

[ymg3]

ekolman,

 

Most of your annotations are now on top of each other.

 

It cannot work. To be able to join the distance has to be to the left.

 

Anyway all of this is always a plaster on a wooden leg. Your annotation should be one text entity

for it to work.

 

Ideally annotations would be attributes to the bar, this way you could separate them.

 

You guys are way too creative when it comes to annotations. You need more rigor if

you want to extract the data.

 

ymg

[ekolman2003]

thanks brother.. How u got a manuel lisp ? for example: I select 2ƒ14 then ı select lenght. and lisp write excel one under the other.

for example 2f14 L=120 I want only this. which rebar I select it will write excel cel A,1 and which rebar lenght I select it write excel cel B,1

3f14 L=250 and other rebar wroten by lisp excel:A,1 and lenght B,2

but its manualy

[ymg3]

there u Go!

 

(defun c:rep2 (/ ent1 ent2 fh fname)
 (setq fname (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) ".csv")
          fh (open fname "a")
 )
 (while (setq en1 (car (entsel "\nSelect a bar: ")))
   (setq en2 (car (entsel "\nSelect it's length: ")))
   (write-line (strcat (cdr (assoc 1 (entget en1))) ", "  (cdr (assoc 1 (entget en2)))) fh)
 )
 (princ (strcat "\nFile: " fname " has been created."))                                               
 (close fh)
)  

[ekolman2003]

very very thanks ymg:)) u are a perfect man:)

[ekolman2003]

Im sorry ymg.Im a problem for u I know:(

But which I select bar type or lenght, its color will change. I dont know which was I selected:((

[ymg3]

This will creates a layer named "SELECTED" with color Yellow.

 

As you select entity rhey will be put on that layer.

 

(defun c:rep2 (/ ent1 ent2 fh fname)
 (setq fname (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) ".csv")
          fh (open fname "a")
 )
 (command "_-LAYER" "_M" "SELECTED" "_C" 2 "" "") 
 (while (setq en1 (car (entsel "\nSelect a bar: ")))
   (setq ent1  (entget en1)
         ent1  (subst (cons 8 "SELECTED") (assoc 8 ent1) ent1)
   )
   (entmod ent1) 
   (setq en2 (car (entsel "\nSelect it's length: ")))
   (setq ent2  (entget en2)
         ent2  (subst (cons 8 "SELECTED") (assoc 8 ent2) ent2)
   )   
   (entmod ent2)
    
   (write-line (strcat (cdr (assoc 1 ent1)) ", "  (cdr (assoc 1 ent2))) fh)
 )
 (princ (strcat "\nFile: " fname " has been created."))                                               
 (close fh)
)

[ekolman2003]

thanks very very much

[kelleci]

Hi

I have a smilar problem about steel quantity.

I replaced ƒ#* text with %%O%%C%%O code but it didnt work in my case.

Here is my project and modified lsp file.Any help i will grateful for this.

Best regards.

TEST.lsp

Project.dwg

[ymg3]

kelleci,

 

Try:

 

(setq ss (ssget "_X" '((0 . "TEXT") (1 . "*%%O%%C%%O*"))))

[kelleci]

Hi

Thanks for the help and interest.But it seems cant find that char.It gives only 3 outputs in excel file.

Here is the code:

 

(defun c:test (/ dir dist en en2 ent ent2 fh fname f1 f2 foundl i j
                mn mx nomatch p1 p2 searchlen ss ss2)

  
 ;; File is opened in Append Mode                                            ;
  
 (setq fname (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) ".csv")
          fh (open fname "a"))
  
 (setq  scrsize   (getvar 'SCREENSIZE)
        ratio     (/ (car scrsize) (cadr scrsize))
        searchlen (* (getvar 'VIEWSIZE) ratio) ; Length of Selection Fence   ;
        nomatch 0 ; Number of Items with no matched length                   ;
 )
  
 ;; Selecting All Text with Character ASCII 131                              ;
 (if (setq ss (ssget "_X" '((0 . "TEXT") (1 . "*%%O%%C%%O*"))))
    (progn
       (repeat (setq i  (sslength ss))
          (setq en (ssname ss (setq i (1- i)))
                ent (entget en)
                dir (cdr (assoc 50 ent))
          )
          (vla-getboundingbox (vlax-ename->vla-object en) 'mn 'mx)
          (setq p1 (vlax-safearray->list mn)
                p2 (vlax-safearray->list mx)
          )
       ;; First point of fence is midpoint of Bar Description.               ;
          (setq f1 (list (/ (+ (car p2) (car p1)) 2.) (/ (+ (cadr p2) (cadr p1)) 2.))
                f2 (polar f1 dir searchlen)
          ) 
          (if (setq ss2 (ssget "_F" (list f1 f2)  '((0 . "TEXT") (1 . "L=#*"))))
             (progn
                (setq foundl nil)
                (repeat (setq j  (sslength ss2))
                   (setq en2  (ssname ss2 (setq j (1- j)))
                         ent2 (entget en2)
                         dist (distance f1 (cdr (assoc 10 ent2)))
                       foundl (cons (list dist (cdr (assoc 1 ent2))) foundl)                 
                   )
                   (setq foundl (vl-sort foundl (function (lambda (a b) (< (car  a) (car  b))))))
                   (write-line (strcat (cdr (assoc 1 ent)) ", "  (cadr (car foundl))) fh)
                )           
             )
             ;; If we did nod not find put a rectangle around the entity.    ;
            (progn 
               (vl-cmdf "_RECTANGLE" p1 p2)
               (setq nomatch (1+ nomatch))
            )      
          )
       )   
    )
 )
 (princ (strcat "File: " fname " has been created."))                                               
 (close fh)
 (if (> nomatch 0) (alert (strcat (itoa nomatch) " Bars could not be matched.")))
 (princ)
)

 

Am i doing something wrong?

Best regards.