Extract Rectangle Dimension To Table (Count & Numbering)

Extract Rectangle Dimension To Table (Count & Numbering)

AlexR7UZ2
Explorer Explorer
8,314 Views
56 Replies
Message 1 of 57

Extract Rectangle Dimension To Table (Count & Numbering)

AlexR7UZ2
Explorer
Explorer

Hi,

 

First off I have little to no experience reading/editing a LISP. I'm trying to see if its possible to combine these two LISPS attached to get what I'm looking for. The AreaLabelV1-9.1 is a great lisp. Unfortunately, it doesn't account for duplicates to create a count # for picked areas or objects like the rectangle_dims LISP does. I need it to have the ability to consolidate duplicate areas so I don't have multiples in the table. 

I'd appreciate any help/advice.🤓

 

-Me

 

0 Likes
8,315 Views
56 Replies
Replies (56)
Message 21 of 57

Sea-Haven
Mentor
Mentor

This is latest version, give it a try.

 

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/extract-rectangle-dimension-to-table-count-amp-numbering/td-p/10321468
; By alanH Nov 2022

(defun c:wow ( / oldsnap oldattdia oldattreq ss lst lst2 big ent obj r i x ans ans2 big area co-ord ht wid sp numrows objtable val tot colwidth)

(defun Make_bubble ( )
  (entmake (list (cons 0 "BLOCK")
    (cons 2 "Pt_num_Bubble")
    (cons 70 2)
    (cons 10 (list 0 0 0))
    (CONS 8 "0")
    )
  )
  (entmake (list (cons 0 "CIRCLE")
	 (cons 8 "0")
	 (cons 10 (list 0 0 0))
	 (cons 40 0.25)
	 (cons 210 (list 0 0 1))
	 (cons 62 256)
	 (cons 39 0)
	 (cons 6 "BYLAYER")
   )
  )
  (entmake (list (cons 0 "ATTDEF")
       (cons 8 "0")
       (cons 10 (list 0 0 0))
       (cons 1 "1")
       (cons 2 "Pt_num_Bubble")
       (cons 3 "Ptnum")
       (cons 6 "BYLAYER")
       (cons 7 "STANDARD")
       (cons 8 "0")
       (cons 11 (list 0.0 0.0 0.0))
       (cons 39 0)
       (cons 40 0.2)
       (cons 41 1)
       (cons 50 0)
       (cons 51 0)
       (cons 62 256)
       (cons 70 0)
       (cons 71 0)
       (cons 72 1)
       (cons 73 0)
       (cons 74 2)
       (cons 210 (list 0 0 1))
  ))
  (entmake (list (cons 0 "ENDBLK")))
  (princ "\nMade Pt_num_Bubble")
  (princ)
)

(defun reccpt (ent  / )
(AH:chkcwccw ent)
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(setq co-ord (rotate-rectang co-ord))
(setq  ht (distance (nth 0 co-ord)(nth 1 co-ord)) wid (distance (nth 1 co-ord) (nth 2 co-ord)))
(setq lst3 (cons (list ht wid) lst3))
(setq x 0.0 y 0.0)
(foreach pt co-ord
(setq x (+ (car pt) x) Y (+ (cadr pt) Y))
)
(setq cpt (list (/ x (length co-ord)) (/ y (length co-ord))))
(command "-insert" "Pt_num_Bubble" "s" 1 cpt 0.0 (rtos (car val) 2 0))
(command "DIM" "align" (nth 0 co-ord) (nth 1 co-ord) (polar (nth 0 co-ord) (+ (/ pi 2.)(angle (nth 0 co-ord) (nth 1 co-ord))) 0.25) "" "exit")
(command "DIM" "align" (nth 1 co-ord) (nth 2 co-ord) (polar (nth 1 co-ord) (+ (/ pi 2.)(angle (nth 1 co-ord) (nth 2 co-ord))) 0.25) "" "exit")
)

;;----------------------=={ Remove Nth }==--------------------;;
;;                                                            ;;
;;  Removes the item at the nth index in a supplied list      ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  n - index of item to remove (zero based)                  ;;
;;  l - list from which item is to be removed                 ;;
;;------------------------------------------------------------;;
;;  Returns:  List with item at index n removed               ;;
;;------------------------------------------------------------;;

(defun LM:RemoveNth ( n l / i )
    (setq i -1)
    (vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l)
)

; By dexus

(defun rotate-rectang (lst / corner)
  (setq corner
    (car
      (vl-sort lst
        (function
          (lambda (a b)
            (if (equal (car a) (car b) 1e-4)
              (< (cadr a) (cadr b))
              (< (car a) (car b))
            )
          )
        )
      )
    )
  )
  (while (/= (car lst) corner) ; rotate until corner is the first item
    (setq lst (append (cdr lst) (list (car lst))))
  )
  lst
)


; Checking if pline is CW or CCW and set to CCW
; Orignal idea  by Kent Cooper, 1 August 2018 Offsetinorout.lsp

(defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint )
(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq pointmin (vlax-safearray->list minpoint))
(setq pointmax (vlax-safearray->list maxpoint))
(setq dist (/ (distance pointmin pointmax) 20.0))
(vla-offset obj dist)
(setq objnew (vlax-ename->vla-object (entlast)))
(setq area1  (vlax-get objnew 'Area))
(vla-delete objnew)
(vla-offset obj (- dist))
(setq objnew (vlax-ename->vla-object (entlast)))
(setq area2  (vlax-get objnew 'Area))
(vla-delete objnew)
(if (> area1 area2)
  (command "Pedit" ent "reverse" "")
)
(princ)
)

(defun  AH:gotable (  / )
(setq rownum (vla-get-rows objtable))
(vla-InsertRows objtable  rownum  (vla-GetRowHeight objtable (- rownum 1)) 1)
(vla-settext objtable rownum  0  (nth 0 ans) )
(vla-settext objtable rownum  1 (rtos (nth 3 ans) 2 3))
(vla-settext objtable rownum  2 "x" )
(vla-settext objtable rownum  3 (rtos (nth 4 ans) 2 3))
(vla-settext objtable rownum 4 (rtos tot 2 0))
(vla-settext objtable rownum 5 (rtos (nth 1 ans) 2 3))
(setq tot 1)
)


(defun CreateTableStyle( / dicts dictobj key class custobj )
    
;; Get the Dictionaries collection and the TableStyle dictionary
(setq dicts (vla-get-Dictionaries (vla-get-ActiveDocument(vlax-get-acad-object))))
(setq dictObj (vla-Item dicts "acad_tablestyle"))

(vlax-for dname dictobj
(if (=  (vla-get-name dname) "Alex" ) ; does it exist
(princ "found")
(setq tablefnd "NO")
)
)

(if (= tablefnd "NO")
(progn
(setq txtht (getreal "\nEnter text height "))
;; Create a custom table style
(setq key "Alex" class "AcDbTableStyle")
(setq custObj (vla-AddObject dictObj key class))

;; Set the name and description for the style
(vla-put-Name custObj "Alex")
(vla-put-Description custObj "Alex custom table style")

;; Sets the bit flag value for the style
(vla-put-BitFlags custObj 1)

;; Sets the direction of the table, top to bottom or bottom to top
(vla-put-FlowDirection custObj acTableTopToBottom)

;; Sets the horizontal margin for the table cells
(vla-put-HorzCellMargin custObj txtht )

;; Sets the vertical margin for the table cells
(vla-put-VertCellMargin custObj txtht )

;; Set the alignment for the Data, Header, and Title rows
(vla-SetAlignment custObj (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter)

;; Set the text height for the Title, Header and Data rows
(vla-SetTextHeight custObj acDataRow txtht)
(vla-SetTextHeight custObj acHeaderRow (* txtht 1.2))
(vla-SetTextHeight custObj acTitleRow (* txtht 1.5))

;; Set the text height and style for the Title row
(vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard")

)
)

(setvar 'ctablestyle "Alex")

(princ)
) ; CreateTableStyle

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
; starts here

(setq oldsnap (getvar "osmode"))
(setvar 'osmode 0)
(setq oldattdia (getvar 'attdia))
(setvar 'attdia 0)
(setq oldattreq (getvar 'attreq))
(setvar 'attreq 0)

(if (= (tblsearch "Block" "Pt_num_Bubble") nil)
(Make_bubble)
(princ "exists")
)
(setvar 'attreq 1)

(CreateTableStyle)

(prompt "Select rectangles ")
(setq ss (ssget '((0 . "LWPOLYLINE"))))

(setq lst '())
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq obj (vlax-ename->vla-object ent))
(setq area (atof (rtos (vla-get-area obj) 2 3)))
(AH:chkcwccw ent)

(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(setq co-ord (rotate-rectang co-ord))
(setq  ht (distance (nth 0 co-ord)(nth 1 co-ord)) wid (distance (nth 1 co-ord) (nth 2 co-ord)))
(setq lst (cons (list area ent ht wid ) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
(setq big (last lst))

(setq lst2 '())
(setq r 1 i 0)
(if (equal (car (nth i lst))(car (nth (1+ i) lst)) 1e-03)
(setq lst2 (cons (list r (car (nth i lst))(cadr (nth i lst)) (nth 2 (nth i lst)) (nth 3 (nth i lst))  ) lst2))
(setq lst2 (cons (list (setq r (1+ r))(car (nth (1+ i) lst))(cadr (nth (1+ i) lst)) (nth 2 (nth i lst)) (nth 3 (nth i lst)) ) lst2))
)
(setq i 1)
(repeat (- (length lst) 2)
(if (equal (car (nth i lst))(car (nth (1+ i) lst)) 1e-03)
(setq lst2 (cons (list r (car (nth i lst))(cadr (nth (1+ i) lst)) (nth 2 (nth i lst)) (nth 3 (nth i lst)) ) lst2))
(setq lst2 (cons (list (setq r (1+ r))(car (nth (1+ i) lst))(cadr (nth (1+ i) lst)) (nth 2 (nth (1+ i) lst)) (nth 3 (nth (1+ i) lst)) ) lst2))
)
(setq i (1+ i))
)

(setq lst2 (reverse lst2))

; make table

(setq sp (vlax-3d-point (getpoint "pick a point for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 7)
(setq numcolumns 6)
(setq rowheight 0.5)
(setq colwidth 3.0)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "Floor Area Calculation")
(vla-settext objtable 1 0 "Type 01")
(vla-settext objtable 2 0 "Description")
(vla-settext objtable 2 1 "Length")
(vla-settext objtable 2 2  "X")
(vla-settext objtable 2 3 "Breadth")
(vla-settext objtable 2 4  "No.")
(vla-settext objtable 2 5  "Area  Sq m.")
(vla-settext objtable 3 0  "Addition")
(vla-settext objtable 4 0  "Block")
(vla-settext objtable 4 2  "X")
(vla-settext objtable 5 0  (rtos (car (last lst2)) 2 0))
(vla-settext objtable 5 5  (rtos (cadr (last lst2)) 2 3))
(vla-settext objtable 5 1 "Total")
(vla-settext objtable 6 0  "Deduction")
(VLA-MERGECELLS objtable  1 1 0 5)
(VLA-MERGECELLS objtable 3 3 0 5)
(VLA-MERGECELLS objtable 5 5 1 4)
(VLA-MERGECELLS objtable 6 6 0 5)

(command "_zoom" "e" "zoom" "0.65XP")
(setq objtable (vlax-ename->vla-object (entlast)))

; draw dims and label

(foreach val lst2
(reccpt (caddr val))
)

; ok to here
; fill in table 

(setq x 0)
(setq tot 1)
(repeat (- (length lst2) 1)
  (setq ans (nth x lst2))
  (setq ans2 (nth (setq x (+ x 1)) lst2))
  (if (= (nth 0 ans)(nth 0 ans2))
    (setq tot (+ tot 1))
    (progn
     (aH:gotable)
	 (setq tot 1)
    )
  )
)


(setvar 'osmode oldsnap)
(setvar 'attdia oldattdia)
(setvar 'attreq oldattreq)
(princ)
)


(c:wow)

Message 22 of 57

AlexR7UZ2
Explorer
Explorer

This looks great! After testing a few times, I found a couple things.

1 - In the attached drawing you can see that the lisp missed one of the #1 blocks. It does this consistently, but it only seems to happen to the #1 blocks. 

2 - The table adds the last # block to the total and doesn't give a length/width/area.

3 - How do I go about changing the Area to Sq. Ft.?

 

Also, is it possible for block information to be linked to the table so that if you added 6" to a rectangle it would automatically update in the table? (Not asking you to do this. Just wondering if it is possible in autocad) 

 

Thanks again for keeping up with this. 

Message 23 of 57

ancrayzy
Advocate
Advocate

Can you share this lisp !

0 Likes
Message 24 of 57

Sea-Haven
Mentor
Mentor

Post 21 ?

0 Likes
Message 25 of 57

ancrayzy
Advocate
Advocate

Thank @Sea-Haven 

Bbut when I use the routine at #21 post, the output table is not the same as the image in post 4.

0 Likes
Message 26 of 57

Sea-Haven
Mentor
Mentor

@ancrazy Post a dwg of what you want as an answer. Yes you will have to make a table and modify to suit what you want it to look like. Only need a few values to see what is required.

Message 27 of 57

ancrayzy
Advocate
Advocate

Hi @Sea-Haven , this is my sample file. The rectangles above are created by separate lines or polylines.

Screenshot 1.jpg

0 Likes
Message 28 of 57

Sea-Haven
Mentor
Mentor

 

@ancrayzy 

Ok need to do step1 1st label the rectangs which are lines, at the same time add to a size list. Then make table from the list of sizes sorting and counting.

 

I have an idea just drag over the rows of rectangs say left to right, this will get sizes. Need to do like 5 times I think much easier than trying to do some sort of XY look up. 

 

Added to my To do list. Somebody else may jump in sooner.

 

Just a last comment if it was me I would do rows columns then enter sizes. So do it as one big program much easier to work with as know the size of each rectang. Adding dimensions and a table.

SeaHaven_0-1723698743011.png

 

 

Message 29 of 57

Sea-Haven
Mentor
Mentor

Just had a play as a 1st step. Save Multi getvals.lsp in a support path. Or add full path to (load "multigetvals") Draws your line work. Next step is label.

 

(defun c:wow ( / ans rows col lst1 lst2 lst x colans rowans pt pt1 pt2)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Enter values " "Rows " 5 4 "6" "Columns " 5 4 "4" )))
(setq rows (atoi (car ans)) col (atoi (cadr ans)))


(if (not AH:getvalsm2col)(Load "Multi getvals 2col"))

(setq lst1 '() lst2 '() x rows)
(repeat rows
(setq lst1 (cons "600" lst1))
(setq lst1 (cons 4 lst1))
(setq lst1 (cons 5 lst1))
(setq lst1 (cons (strcat "Height " (rtos x 2 0)) lst1))
(setq x (1- x))
)
(setq lst1 (cons "enter values " lst1))
(setq rowans (AH:getvalsm lst1))

(setq x col)
(repeat col
(setq lst2 (cons "600" lst2))
(setq lst2 (cons 4 lst2))
(setq lst2 (cons 5 lst2))
(setq lst2 (cons (strcat "Length  " (rtos x 2 0)) lst2))
(setq x (1- x))
)
(setq lst2 (cons "enter values " lst2))
(setq colans (AH:getvalsm lst2))

(setq pt (getpoint "\nPick a point for top left cotner "))
; do columns
(setq ss nil)
(setq pt1 pt ss (ssadd))
(foreach val rowans
(setq pt2 (mapcar '+ pt1 (list 0.0 (- (atof val)) 0.0)))
(command "line" pt1 pt2 "")
(setq ss (ssadd (entlast) ss))
(setq pt1 pt2)
)

(setq dist 0.0)
(foreach val colans
(command "copy" ss "" pt (mapcar '+ pt (list (setq dist (+ dist (atof val))) 0.0 0.0)))
)

; do Rows
(setq ss nil)
(setq pt1 pt ss (ssadd))
(setq dist 0.0)
(foreach val colans
(setq pt2 (mapcar '+ pt1 (list (atof val) 0.0 0.0)))
(command "line" pt1 pt2 "")
(setq ss (ssadd (entlast) ss))
(setq pt1 pt2)
)

(setq dist 0.0)
(foreach val rowans
(command "copy" ss "" pt (mapcar '+ pt (list 0.0 (setq dist (- dist (atof val))) 0.0)))
)

(princ)
)

SeaHaven_0-1723704316978.png

 

 

Message 30 of 57

ancrayzy
Advocate
Advocate

@Sea-Havenyour Multi getvals.lsp is very useful for many rountines.

I run your wow lisp above and gets some errors. I fixed them with chat PGT and it work perfect.

The errors check by chat GPT

 

 

 

 

 

Unmatched ss initialization: You initialize ss before the foreach loops but then reinitialize it at the start of each loop. The initial ss value is overridden and seems unnecessary.
Spelling mistake: "cotner" should be "corner" in the getpoint prompt.
Checking function loading: If the external functions AH:getvalsm and AH:getvalsm2col are not loaded, the script loads them. However, you load "Multi getvals 2col" even though it's not used in this script.

 

 

 

 

 

The the fixed code by GPT

 

 

 

 

 

(defun c:wow ( / ans rows col lst1 lst2 lst x colans rowans pt pt1 pt2 oldsnap ss dist)

  ;; Save the current osnap settings and disable osnap
  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)

  ;; Load necessary functions if they are not loaded
  (if (not AH:getvalsm)
    (load "Multi Getvals.lsp")
  )

  ;; Get the number of rows and columns from the user
  (setq ans (AH:getvalsm (list "Enter values " "Rows " 5 4 "6" "Columns " 5 4 "4")))
  (setq rows (atoi (car ans)) col (atoi (cadr ans)))

  ;; Initialize lists for row and column values
  (setq lst1 '() lst2 '() x rows)
  
  ;; Collect row values
  (repeat rows
    (setq lst1 (cons "600" lst1))
    (setq lst1 (cons 4 lst1))
    (setq lst1 (cons 5 lst1))
    (setq lst1 (cons (strcat "Height " (rtos x 2 0)) lst1))
    (setq x (1- x))
  )
  (setq lst1 (cons "Enter values " lst1))
  (setq rowans (AH:getvalsm lst1))

  ;; Collect column values
  (setq x col)
  (repeat col
    (setq lst2 (cons "600" lst2))
    (setq lst2 (cons 4 lst2))
    (setq lst2 (cons 5 lst2))
    (setq lst2 (cons (strcat "Length " (rtos x 2 0)) lst2))
    (setq x (1- x))
  )
  (setq lst2 (cons "Enter values " lst2))
  (setq colans (AH:getvalsm lst2))

  ;; Prompt the user to pick a point for the top-left corner
  (setq pt (getpoint "\nPick a point for top left corner "))

  ;; Process row values
  (setq pt1 pt ss (ssadd))
  (foreach val rowans
    (setq pt2 (mapcar '+ pt1 (list 0.0 (- (atof val)) 0.0)))
    (command "line" pt1 pt2 "")
    (setq ss (ssadd (entlast) ss))
    (setq pt1 pt2)
  )

  ;; Process column values
  (setq dist 0.0)
  (foreach val colans
    (command "copy" ss "" pt (mapcar '+ pt (list (setq dist (+ dist (atof val))) 0.0 0.0)))
  )

  ;; Redo rows for remaining columns
  (setq pt1 pt ss (ssadd))
  (setq dist 0.0)
  (foreach val colans
    (setq pt2 (mapcar '+ pt1 (list (atof val) 0.0 0.0)))
    (command "line" pt1 pt2 "")
    (setq ss (ssadd (entlast) ss))
    (setq pt1 pt2)
  )

  ;; Copy rows downward
  (setq dist 0.0)
  (foreach val rowans
    (command "copy" ss "" pt (mapcar '+ pt (list 0.0 (setq dist (- dist (atof val))) 0.0)))
  )

  ;; Restore the original osnap settings
  (setvar 'osmode oldsnap)

  ;; End the program
  (princ)
)

 

 

 

 

 

Waiting for your next step to count rectangles and mark them.

I think the labeling step should be done as a separate step and can be skip the making rangtangles at 1st step.

For example, we had the rectangles before and just lable then count them.

0 Likes
Message 31 of 57

ancrayzy
Advocate
Advocate

If those objects are rectangles as attachment file, does anyone have any solution?

For example, I have content in the input section. After running the LISP, I get the same output as shown in the output section, and I also generate the table as shown.

Screenshot_1.png

0 Likes
Message 32 of 57

Sea-Haven
Mentor
Mentor

Changing to rectangs makes it so much easier. 1st dwg was all lines, I guess start again I had started to work on something  but very busy time poor.

Message 33 of 57

ancrayzy
Advocate
Advocate

Thank you @Sea-Haven 

Let me clarify,

- The drawing content of input section is already available, so there's no need for the LISP to create it as the first step.

- Just need to lable and export to table.

0 Likes
Message 34 of 57

Sea-Haven
Mentor
Mentor

For me its easier to get all the info as this can be used in auto making rectangs and dimensioning the grids, 3rd go make rectangs, but will do just use what you have first.

 

Numbers squares. And does table.

 

 

;;;;;;;;;;; version 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:wow ( / oldsnap mp label ss s1 s2 tmp)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(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 (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(defun golabel (row col / )
  (cond 
  ((and (= row 600)(= col 600))(setq label "1"))
  ((and (= row 600)(= col 300))(setq label "2"))
  ((and (= row 600)(= col 200))(setq label "3"))
  ((and (= row 600)(>= col 450)(<= col 600))(setq label "1.1"))
  ((and (= row 600)(>= col 300)(<= col 400))(setq label "4"))
  ((and (<= col 600)(<= row 600))(setq label "1.2"))
  )
  (princ (strcat "\n" label))
  (setq mp (mapcar '* (mapcar '+ (car co-ord) (caddr co-ord)) '(0.5 0.5)))
  (command "text" "J" "MC" mp  100 0 label)
  (setq lst2 (cons label lst2))
  (setq lst (cons lst2 lst))
)

(setq ss (ssget '((0 . "LWPOLYLINE"))))

(setq lst '())
(repeat (setq k (sslength ss))
  (setq lst2 '())
  (setq plent (ssname ss (setq k (- k 1))))
  (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent))))
  (setq lay (cdr (assoc 8 (entget plent))))
  (setq s1 (distance (car co-ord)(cadr co-ord)))
  (setq s2 (distance (cadr co-ord)(caddr co-ord)))
  (setq lst2 (cons s1 lst2))
  (setq lst2 (cons s2 lst2))
  (setq lst2 (cons lay lst2))
  (if (< s1 s2)
  (setq tmp s1
  s1 s2
  s2 tmp)
  )
  (golabel s1 s2)
)

(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 (vl-sort lst3 '(lambda (x y) (< (car (car x))(car (car y))))))

(setq sp (vlax-3d-point (getpoint "pick a point for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 2)
(setq numcolumns 5)
(setq rowheight 200)
(setq colwidth 750)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "Rectangles Count")
(vla-settext objtable 1 0 "Layer") 
(vla-settext objtable 1 1 "Length") 
(vla-settext objtable 1 2 "Width")
(vla-settext objtable 1 3 "Count")
(vla-settext objtable 1 4 "ID")
(setq objtable (vlax-ename->vla-object (entlast)))

(setq rownum 2)

(foreach val lst3
  (vla-InsertRows objtable rownum  200 1)
  (vla-settext objtable rownum  0 (cadr (car val)))
  (vla-settext objtable rownum  1 (rtos (caddr (car val)) 2 2 ))
  (vla-settext objtable rownum  2 (rtos (cadddr (car val)) 2 2 ))
  (vla-settext objtable rownum  4 (car (car val)))
  (vla-settext objtable rownum  3 (rtos (cadr val) 2 0))
  (setq rownum (1+ rownum))
)

(vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) 100.0)
(vla-SetAlignment  objtable (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter)

(setvar 'osmode oldsnap)
(princ)
)

 

 

Message 35 of 57

ancrayzy
Advocate
Advocate

Awesome, it worked  perfect @Sea-Haven 😃

Waiting for your next step

0 Likes
Message 36 of 57

Sea-Haven
Mentor
Mentor

Updated code above. Post 34.

 

Do you really need layer ? Is the layer option needed where you will have rectangs on different layers ? If so post sample dwg.

Message 37 of 57

ancrayzy
Advocate
Advocate

Thank you a gain @Sea-Haven ,

I want the 'Layer' column because I need to count the rectangular objects by different layers in a single operation. This will greatly reduce the time required for the task.

The 2nd version work well but missing layer name in "Layer" column as the attachment photo.

There may be missing information in the table creation section code

 

Wow2.png 

The attachment for your post #36, the result may like this photo.

Wow3.png

0 Likes
Message 38 of 57

Sea-Haven
Mentor
Mentor

I was just worried that each rectang could be on a different layer, you would do a selection1 do table, do selection2 then add more to table, selection3 and so on.

 

Will update.

Message 39 of 57

ancrayzy
Advocate
Advocate

Thanks for your all your help @Sea-Haven 

I will use the method as you mentioned until there is a better solution if any.

0 Likes
Message 40 of 57

Sea-Haven
Mentor
Mentor

Just need time to add layer and more groups, also will do start with blank dwg and draw rectangs from input.