I have a lisp code want to merge same row and count the merg rawes in end coulom

[manizheh]

(defun c:boxlwh (/ f fn s i j ed pos plist boxL boxW boxH aline  )
; creates a comma delimited (CSV) file of the length, width, and height
; of 3D SOLID boxes that the user selects.
; The boxes may be at any 3D orientation  
; The user should select only those solids that were created
; with the BOX command
; Notes,
; This version creates a layer named "deletethislayer" which
; has no objects when the program finishes successfully.
; All layer are unfrozen upon complete with layer 0 current.  
; Lee Minardi version 1.0 4/26/2020

(setq f (getfiled "Create Output File" "" "csv" 1))
(setq fn (open f "w"))
(command "-layer" "m" "deletethislayer" "")
(command "-layer" "s" "deletethislayer" "" "")
(command "erase" "a" "")
;;;  (command "select" "")
(setq a (ssget))
(command "copy" "p" "" "0,0,0" "")
(command "chprop" "p" "" "LA" "deletethislayer" "")
(command "-layer" "f" "*" "")
(command "xedges" "all" "")
(setq plist nil)
(if
  (setq ss (ssget "_A" '((0 . "LINE"))))
   (progn
     (setq i 0)
     (setq j 0)
     (while (setq en (ssname ss i))
       (setq ed (entget en))
       (setq pos (cdr (assoc 11 ed)))
       (setq plist (append plist (list pos)))
;;;          (command "point" pos "")  ; used for debugging
;;;          (command "text" pos "" "" j "")
       (setq i (1+ i)
         j (1+ j)
       )
       (if (> j 11)
     (progn
       (setq j 0)
       (setq boxL (distance (nth 0 plist) (nth 1 plist))
                      boxW (distance (nth 1 plist) (nth 3 plist))
                      boxH (distance (nth 3 plist) (nth 9 plist)))
                (setq distances (list boxL boxW boxH))
                (setq distances (vl-sort distances '>)) ; Sort distances in descending order
                (setq aline (strcat
                              (rtos (car distances))
                              ","
                              (rtos (cadr distances))
                              ","
                              (rtos (caddr distances))))
                    ;  (princ aline)
       (write-line aline fn)
       (princ)

     )                ; end progn  
       )
     )                    ;end while
   )                    ; end progn lines
)                    ;end if
(close fn)
(command "erase" "all" "")
(command "-layer" "t" "*" "")
(command "-layer" "s" "0" "")
(command "-laydel" "n" "deletethislayer" "" "y") 
(princ "\nDONE")
(princ)
)

 

Edited October 24, 2023 by SLW210
Added Code Tags!!

[BIGAL]

"I have a lisp code want to merge same row and count the merge rows in end column.

 

I think its a language problem. You are saving X Y Z values, what do you want to count up ?

 

Show example.

 

 

 

 

[manizheh]

10 hours ago, BIGAL said:

"I have a lisp code want to merge same row and count the merge rows in end column.

 

I think its a language problem. You are saving X Y Z values, what do you want to count up ?

 

Show example.

 

I want to specify the number of those 3 Solid that have the same size in the CVS file.

 

 

 

[SLW210]

Please use Code Tags (use the <> in the editor) in the future.

[manizheh]

12 hours ago, BIGAL said:

 

I have a lisp code where I want to merge identical rows of the same values and display the number of merged rows in front of their values in the last column. I have shared my code above

 

 

[BIGAL]

Ok understand it may be better to use massprop to get the size of your solids. Have something somewhere will try to find.

[manizheh]

6 hours ago, BIGAL said:

Ok understand it may be better to use massprop to get the size of your solids. Have something somewhere will try to find.

Could you explain more?

[manizheh]

7 hours ago, BIGAL said:

Ok understand it may be better to use massprop to get the size of your solids. Have something somewhere will try to find.

Using the massprop command in AutoCAD is commonly used to obtain the properties of 3D objects, including volume, area, and center of mass. Is it useful for length, width, height and counting the same values?

[manizheh]

I have I also have this code but it has this error when running ; error: too many arguments

 

6.lsp

Edited October 25, 2023 by manizheh

[BIGAL]

I am so close but there is a bug and I can not see it, the code makes a list "lst" of the sorted XYZ values, the function remove doubles is not working, I have made the lst manually as a copy of the generated lst and it works correct. Then do the count function and output. To test just make some simple shapes like circle and rectangs and extrude them make copies so the count function works. Perhaps another set of eyes will reveal the fault.

; new to do.
; https://www.cadtutor.net/forum/topic/78533-i-have-a-lisp-code-want-to-merge-same-row-and-count-the-merg-rawes-in-end-coulom/

(defun c:wow ( / dummy)

(setvar 'filedia 1)

;;-------------------=={ Parse Numbers }==--------------------;;`
;;                                                            ;;
;;  Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  s - String to process                                     ;;
;;------------------------------------------------------------;;
;;  Returns:  List of numerical values found in string.       ;;
;;------------------------------------------------------------;;

(defun LM:ParseNumbers ( s )
  (
    (lambda ( l )
      (read
        (strcat "("
          (vl-list->string
            (mapcar
              (function
                (lambda ( a b c )
                  (if
                    (or
                      (< 47 b 58)
                      (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                      (and (= 46 b) (< 47 a 58) (< 47 c 58))
                    )
                    b 32
                  )
                )
              )
              (cons nil l) l (append (cdr l) (list nil))
            )
          )
          ")"
        )
      )
    )
    (vl-string->list s)
  )
)

; By Gile
(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (alst)
  (if alst
    (cons (car alst) (remove_doubles (vl-remove (car alst) alst)))
  )
)

(setq lst '() lst2 '())

(prompt "\nPick solids Enter to stop ")
(if (setq ss (ssget '((0 . "3DSOLID"))))
(progn
  (repeat (setq K (sslength ss))
   (setq ent (ssname ss (setq k (1- k))))
   (command "massprop" ent "" "y" (setq fname (vl-filename-mktemp "" "" ".dcl")))
   (setq fn (open fname "R"))
; ignore 5 lines at start
   (repeat 5
    (setq dummy (read-line fn))
   )

   (setq b1 (read-line fn))
   (setq box1 (LM:ParseNumbers b1))
   (setq b2 (read-line fn))
   (setq box2 (LM:ParseNumbers b2))
   (setq x (- (car box2)(car box1))
         Y (- (cadr box2)(cadr box1))
         Z (- (caddr box2)(caddr box1))
   )
   (setq xyz (list x y z))
   (setq xyz (vl-sort xyz '> ))
   (setq lst (cons xyz lst))
   
   (close fn)
   (vl-file-delete fname)
   ) ; ss repeat


  (setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) (< (cadr a) (cadr b)))
		  ((= (car a) (car b)) (< (cadr a) (cadr b))(< (caddr a) (caddr b)))
	    )
	  )
    )
  )


  (setq lst3 '())
  (setq lst2 (remove_doubles lst))
  (foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
  )
  (setq lst3 (reverse lst3))

  (setq dwgname (getvar 'dwgname) dwgpre (getvar 'dwgprefix))
  (setq fo (open (setq fnout (strcat dwgpre dwgname ".csv")) "W"))

  (foreach box lst3
   (write-line (strcat (rtos (car (car box)) 2 3) "," (rtos (cadr (car box)) 2 3) "," (rtos (caddr (car box)) 2 3) "," (rtos (cadr box) 2 0)) fo)
  )

  (close fo)

) ;progn
) ;if

(princ)
)
(c:wow)

 

 

 

[manizheh]

On 10/26/2023 at 8:14 AM, BIGAL said:

I am so close but there is a bug and I can not see it, the code makes a list "lst" of the sorted XYZ values, the function remove doubles is not working, I have made the lst manually as a copy of the generated lst and it works correct. Then do the count function and output. To test just make some simple shapes like circle and rectangs and extrude them make copies so the count function works. Perhaps another set of eyes will reveal the fault.

; new to do.
; https://www.cadtutor.net/forum/topic/78533-i-have-a-lisp-code-want-to-merge-same-row-and-count-the-merg-rawes-in-end-coulom/

(defun c:wow ( / dummy)

(setvar 'filedia 1)

;;-------------------=={ Parse Numbers }==--------------------;;`
;;                                                            ;;
;;  Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  s - String to process                                     ;;
;;------------------------------------------------------------;;
;;  Returns:  List of numerical values found in string.       ;;
;;------------------------------------------------------------;;

(defun LM:ParseNumbers ( s )
  (
    (lambda ( l )
      (read
        (strcat "("
          (vl-list->string
            (mapcar
              (function
                (lambda ( a b c )
                  (if
                    (or
                      (< 47 b 58)
                      (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                      (and (= 46 b) (< 47 a 58) (< 47 c 58))
                    )
                    b 32
                  )
                )
              )
              (cons nil l) l (append (cdr l) (list nil))
            )
          )
          ")"
        )
      )
    )
    (vl-string->list s)
  )
)

; By Gile
(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (alst)
  (if alst
    (cons (car alst) (remove_doubles (vl-remove (car alst) alst)))
  )
)

(setq lst '() lst2 '())

(prompt "\nPick solids Enter to stop ")
(if (setq ss (ssget '((0 . "3DSOLID"))))
(progn
  (repeat (setq K (sslength ss))
   (setq ent (ssname ss (setq k (1- k))))
   (command "massprop" ent "" "y" (setq fname (vl-filename-mktemp "" "" ".dcl")))
   (setq fn (open fname "R"))
; ignore 5 lines at start
   (repeat 5
    (setq dummy (read-line fn))
   )

   (setq b1 (read-line fn))
   (setq box1 (LM:ParseNumbers b1))
   (setq b2 (read-line fn))
   (setq box2 (LM:ParseNumbers b2))
   (setq x (- (car box2)(car box1))
         Y (- (cadr box2)(cadr box1))
         Z (- (caddr box2)(caddr box1))
   )
   (setq xyz (list x y z))
   (setq xyz (vl-sort xyz '> ))
   (setq lst (cons xyz lst))
   
   (close fn)
   (vl-file-delete fname)
   ) ; ss repeat


  (setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b)) (< (cadr a) (cadr b)))
		  ((= (car a) (car b)) (< (cadr a) (cadr b))(< (caddr a) (caddr b)))
	    )
	  )
    )
  )


  (setq lst3 '())
  (setq lst2 (remove_doubles lst))
  (foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
  )
  (setq lst3 (reverse lst3))

  (setq dwgname (getvar 'dwgname) dwgpre (getvar 'dwgprefix))
  (setq fo (open (setq fnout (strcat dwgpre dwgname ".csv")) "W"))

  (foreach box lst3
   (write-line (strcat (rtos (car (car box)) 2 3) "," (rtos (cadr (car box)) 2 3) "," (rtos (caddr (car box)) 2 3) "," (rtos (cadr box) 2 0)) fo)
  )

  (close fo)

) ;progn
) ;if

(princ)
)
(c:wow)

 

 

 

The output of this program is the coordinates, not the size, and the counting of boxes with the same size

[BIGAL]

Ok the mass prop line has the bounding box co-ordinates, and the size  has already been worked out, will try again when have some time.