Jump to content

Recommended Posts

Posted

@RonnieBN Give this a shot.

 

(defun c:Test ( / int sel cad ent lst ref one two out csv get)
  ;; Tharwat Al Choufi	- Date: 4.Mar.2021	;;
  (and (princ "\nSelect closed polylines with four corners : ")
       (setq int -1 sel (ssget '((0 . "*POLYLINE") (-4 . "<AND") (-4 . "&=") (70 . 1) (90 . 4) (-4 . "AND>"))))
       (or (vla-zoomextents (setq cad (vlax-get-acad-object))) t)
       (while (setq int (1+ int) ent (ssname sel int))
         (setq lst nil)
         (foreach p (entget ent)
           (if (= (car p) 10) (setq lst (cons (cdr p) lst)))
           )
         (and (setq ref (ssget "_CP" lst '((0 . "TEXT"))))
              (setq one (distance (car lst) (cadr lst))
                    two (distance (car lst) (last lst))
                    )
              (if (equal (cadar lst) (cadadr lst) 1e-4)
                (setq len one wid two)
                (setq len two wid one)
                )
              (setq out (cons (list len wid (cdr (assoc 1 (entget (ssname ref 0))))) out))
              )
         )
       (or (vla-zoomprevious cad) t)
       (setq csv (getfiled "Specify file name" (getvar 'DWGPREFIX) "csv" 1))
       (setq get (open csv "w"))
       (write-line "L,W,ID" get)
       (foreach itm out
         (write-line (strcat (rtos (car itm) 2 2) "," (rtos (cadr itm) 2 2) "," (caddr itm)) get)
         )
       (close get)
       )
  (princ)
  ) (vl-load-com)

 

  • Like 1
Posted
20 hours ago, Tharwat said:

Give this a shot.

Thanks Tharwat! It works. But an we make it works with the rectangles without the ID inside?

Posted
3 minutes ago, RonnieBN said:

Thanks Tharwat! It works. But can we make it works with the rectangles without the ID inside?

 

Certainly. :) 

(defun c:Test ( / int sel cad ent lst one two out csv get)
  ;; Tharwat Al Choufi	- Date: 4.Mar.2021	;;
  (and (princ "\nSelect closed polylines with four corners : ")
       (setq int -1 sel (ssget '((0 . "*POLYLINE") (-4 . "<AND") (-4 . "&=") (70 . 1) (90 . 4) (-4 . "AND>"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (setq lst nil)
         (foreach p (entget ent)
           (if (= (car p) 10) (setq lst (cons (cdr p) lst)))
           )
         (and (setq one (distance (car lst) (cadr lst))
                    two (distance (car lst) (last lst))
                    )
              (if (equal (cadar lst) (cadadr lst) 1e-4)
                (setq len one wid two)
                (setq len two wid one)
                )
              (setq out (cons (list len wid) out))
              )
         )
       (setq csv (getfiled "Specify file name" (getvar 'DWGPREFIX) "csv" 1))
       (setq get (open csv "w"))
       (write-line "L,W" get)
       (foreach itm out
         (write-line (strcat (rtos (car itm) 2 2) "," (rtos (cadr itm) 2 2)) get)
         )
       (close get)
       )
  (princ)
  ) 

 

Posted

Just test your work. Thanks! 

I was meaning that could we make the lisp give the results as for both case 1- with the ID and 2-without the ID in only one command/lisp. 

Thanks!

image.thumb.png.db28ac421969f8e0c43a7448ee5714ff.png

Posted

I wish you can make a donation then I will make it for you as well. :) 

Posted
On 3/5/2021 at 11:42 AM, Tharwat said:

I wish you can make a donation then I will make it for you as well. :) 

Hi, I am not able to make the donation at this time.

I really appreciate your works. Thanks!

Posted
25 minutes ago, RonnieBN said:

Hi, I am not able to make the donation at this time.

I really appreciate your works. Thanks!

No worries @RonnieBN , please find the latest version that should cover the two options with / without ID [ Yes , No ] < Default value Tes > as ordered in the program.

 

Please try the following untested codes and let me know how you get on with it.

 

(defun c:Test (/ *error* rep int sel zom cad ent lst ref one two out csv get)
  ;; Tharwat Al Choufi	- Date: 8.Mar.2021	;;
  (defun *error* (msg)
    (and cad zom (vla-zoomprevious cad))
    (and msg
         (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*BREAK*"))
         (princ (strcat "\nError =>: " msg))
    )
    (princ)
  )
  ;;			;;
  (and (or (initget 6 "Yes No")
           (setq rep
                  (cond ((getkword "\nInclude ID column [Yes,No] < Yes > : "))
                        ("Yes")
                  )
           )
       )
       (princ "\nSelect closed polylines with four corners : ")
       (setq int -1
             sel (ssget '((0 . "*POLYLINE")
                          (-4 . "<AND")
                          (-4 . "&=")
                          (70 . 1)
                          (90 . 4)
                          (-4 . "AND>")
                         )
                 )
       )
       (setq
         zom (or (vla-zoomextents (setq cad (vlax-get-acad-object))) t)
       )
       (while (setq int (1+ int)
                    ent (ssname sel int)
              )
         (setq lst nil)
         (foreach p (entget ent)
           (if (= (car p) 10)
             (setq lst (cons (cdr p) lst))
           )
         )
         (and (setq one (distance (car lst) (cadr lst))
                    two (distance (car lst) (last lst))
              )
              (if (equal (cadar lst) (cadadr lst) 1e-4)
                (setq len one
                      wid two
                )
                (setq len two
                      wid one
                )
              )
              (setq out
                     (cons
                       (list
                         len
                         wid
                         (if (and (= rep "Yes")
                                  (setq ref (ssget "_CP" lst '((0 . "TEXT"))))
                             )
                           (cdr (assoc 1 (entget (ssname ref 0))))
                           ","
                         )
                       )
                       out
                     )
              )
         )
       )
       (or (setq zom (vla-zoomprevious cad)) t)
       (setq
         csv (getfiled "Specify file name" (getvar 'DWGPREFIX) "csv" 1)
       )
       (setq get (open csv "w"))
       (write-line
         (strcat "L,W"
                 (if (= rep "Yes")
                   ",ID"
                   ""
                 )
         )
         get
       )
       (foreach itm out
         (write-line
           (strcat (rtos (car itm) 2 2)
                   ","
                   (rtos (cadr itm) 2 2)
                   ","
                   (caddr itm)
           )
           get
         )
       )
       (close get)
  )
  (princ)
) (vl-load-com)

 

  • Like 1
Posted
20 hours ago, Tharwat said:

No worries @RonnieBN , please find the latest version that should cover the two options with / without ID [ Yes , No ] < Default value Tes > as ordered in the program.

 

Please try the following untested codes and let me know how you get on with it.

I have tested. It works perfectly and so helpful. I appreciate so much! 

 

Posted
1 hour ago, RonnieBN said:

I have tested. It works perfectly and so helpful. I appreciate so much! 

 

 

You're welcome anytime. :) 

  • 5 months later...
Posted

Hey Tharwat. I am a newbie here in lisp. Can you tell me how do I change whats the outcome in excel file. I have attached jpeg showing how I want. What lines do I need to Edit?

sample.JPG

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

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