hmtpk Posted March 22, 2023 Share Posted March 22, 2023 Hello ; Sorry for my English. I can get the table in the dwg file with the lisp I sent in the attachment. What I want is to add linetype and color columns to the same table and create a table like the one that says after. Thank you for your attention. TEST.dwg AA-Kalıp metraj seçilen kısmın alanı(kolon perde ).lsp Quote Link to comment Share on other sites More sharing options...
BIGAL Posted March 22, 2023 Share Posted March 22, 2023 The ahmktable is my code so that part is easy to comment about. (setq numcolumns 5) change 5 to 7. (vla-settext objtable 1 0 "NO") (vla-settext objtable 1 1 "LINETYPE") (vla-settext objtable 1 2 "LAYER COLOR") (vla-settext objtable 1 3 "LAYER NAME") (vla-settext objtable 1 4 "LENGTH") (vla-settext objtable 1 5 "HEIGHT") (vla-settext objtable 1 6 "AREA") (vla-Setcolumnwidth Objtable 0 50) (vla-Setcolumnwidth Objtable 1 400) (vla-Setcolumnwidth Objtable 2 400) (vla-Setcolumnwidth Objtable 3 400) (vla-Setcolumnwidth Objtable 4 100) (vla-Setcolumnwidth Objtable 5 100) (vla-Setcolumnwidth Objtable 6 150) You need to look for linetype in cell (setq col laycol) ; layer color 1-254 RGB done similar VLA-set-rgb (setq acm (vla-getinterfaceobject (vlax-get-acad-object) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))) (vla-put-colorindex acm laycol) (vla-setcellbackgroundcolor obj 2 2 acm) ; obj row col acm NOT TESTED. 1 Quote Link to comment Share on other sites More sharing options...
hmtpk Posted March 23, 2023 Author Share Posted March 23, 2023 Yes, Mr. Bigal. The code is your code. Thank you again. I made the changes you mentioned, but it didn't work. Could you please make the changes in Lisp and publish them. Quote Link to comment Share on other sites More sharing options...
devitg Posted March 23, 2023 Share Posted March 23, 2023 12 hours ago, hmtpk said: I made the changes you mentioned, but it didn't work. @hmtpk Please could you upload your list with the modification you did? I made some modifications but I do not know how to set the cell at column 2 to show the LINE with it's LINETYPE (repeat (setq x (length lst2)) (setq itlst (nth i lst2)) (vla-settext objtable 0 0 "KALIP METRAJ [ m² ]"); TABLE TITLE (vla-settext objtable 1 0 "NO") (vla-settext objtable 1 1 "LINETYPE") (vla-settext objtable 1 2 "LAYER COLOUR") (vla-settext objtable 1 3"LAYER NAME") (vla-settext objtable 1 4 "LENGTH") (vla-settext objtable 1 5 "HEIGHT") (vla-settext objtable 1 6 "AREA") (vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) 12) (VLA-SETCOLUMNWIDTH OBJTABLE 0 50) (VLA-SETCOLUMNWIDTH OBJTABLE 1 150) (VLA-SETCOLUMNWIDTH OBJTABLE 2 200) (VLA-SETCOLUMNWIDTH OBJTABLE 3 400) (VLA-SETCOLUMNWIDTH OBJTABLE 4 100) (VLA-SETCOLUMNWIDTH OBJTABLE 5 100) (VLA-SETCOLUMNWIDTH OBJTABLE 6 150) (setq col laycol) ; layer color 1-254 RGB done similar VLA-set-rgb ;(setq layer ( vla-item lay-coll (CAR ITLST))) (setq layer-data(tblsearch "layer" (CAR ITLST))) ;(setq col (vla-get-TrueColor layer)) (setq col (cdr (assoc 62 layer-data))) (setq acm (vla-getinterfaceobject (vlax-get-acad-object) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))) (vla-put-colorindex acm col) (vla-settext objtable row 0 (rtos no 2 0)) ;;;(vla-settext objtable row 1 ) (vla-setcellbackgroundcolor OBJTABLE 2 2 acm) ; obj row col acm (VLA-SETTEXT OBJTABLE ROW 3 (CAR ITLST)) (VLA-SETTEXT OBJTABLE ROW 4 (RTOS (CADR ITLST) 2 3)) (VLA-SETTEXT OBJTABLE ROW 5 (RTOS (CADDR ITLST) 2 3)) (VLA-SETTEXT OBJTABLE ROW 6 (RTOS (* (CADR ITLST) (CADDR ITLST)) 2 3)) (setq voltot (+ (*(cadr itlst)(caddr itlst)) voltot)) (setq row (+ row 1)) (setq i (+ i 1)) (setq no (+ no 1)) ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted March 23, 2023 Share Posted March 23, 2023 (edited) You can set background color & insert a block into a cell, not sure about a line in a cell. May need to get the properties of the cell somehow, the box values and just draw a line. It may need to be worked out from 1st principles like row & column size values. The title row can be made bigger than the data rows. The top left corner is the table insert point, you picked so the X and -Y from it to work out where a line would be drawn. y =pty - (1st height+row height+1/2 row height). Next row subtract row height from y. x1=ptx + col 0 width+say2 x2=ptx + col 0 width+ col 1width - say 2 This should match you table Post the updated code that you said did not work. It is better to see what was wrong and make corrections, then you learn. Edited March 23, 2023 by BIGAL Quote Link to comment Share on other sites More sharing options...
devitg Posted March 24, 2023 Share Posted March 24, 2023 37 minutes ago, BIGAL said: Post the updated code that you said did not work @BIGAL The code is as I put , you can see I comment this line ;;;(vla-settext objtable row 1 ) because I can not get the way to put a LINE at ROW and column 1 . As it is show here. It have no error , just a way to put a LINE at that CELL I think a option to put a TEXT "___________" by underscore and then justify to fit a the cell center (vla-settext objtable row 1 "___________" ) table with text as LINE.dwg Quote Link to comment Share on other sites More sharing options...
BIGAL Posted March 24, 2023 Share Posted March 24, 2023 Nice idea but what about -----G------ time to go and have a beer at fishing club will look into the draw a line in a cell note its exactly that a line nothing to do with a table. 2 Quote Link to comment Share on other sites More sharing options...
hmtpk Posted March 25, 2023 Author Share Posted March 25, 2023 Mr. Bigal we are waiting for your help Quote Link to comment Share on other sites More sharing options...
BIGAL Posted March 25, 2023 Share Posted March 25, 2023 I will have time today to try and do something. Quote Link to comment Share on other sites More sharing options...
hamit Posted March 30, 2023 Share Posted March 30, 2023 Can you help with this lisp Quote Link to comment Share on other sites More sharing options...
BIGAL Posted March 31, 2023 Share Posted March 31, 2023 (edited) Sorry lost the link I was trying to find it the title did not help if it had Table in it would have found sooner. It only seems to do 1 layer. ; https://www.cadtutor.net/forum/topic/77165-can-you-help-about-lisp/ ;;---------------------=={ Total Area }==---------------------;; ;; ;; ;; Displays the total area of selected objects at the ;; ;; command line. The precision of the printed result is ;; ;; dependent on the setting of the LUPREC system variable. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ; Total area modified by Alanh to allow multiple pick by layer ; uses height in layer name for volume expect metric ; Nov 2019 ; Added a linetype to cells ; Added a layer color to cells ; BY AlanH April 2023 ;; Parse Numbers - Lee Mac ;; Parses a list of numerical values from a supplied string. ;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;------------------------------------------------------------;; (defun LM:parsenumbers ( str ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar '(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) '(())) ) ) ")" ) ) ) (vl-string->list str) ) ) (defun ahdodrawline (llayer crow lcol / pt pt1 pt2 vdist acm ) (setq pts (vlax-safearray->list (vlax-variant-value (VLA-GETCELLEXTENTS objtable (+ crow 1) 1 :vlax-false)))) (setq pt1 (list (nth 0 pts)(nth 1 pts) 0.0)) (setq pt2 (list (nth 6 pts)(nth 7 pts) 0.0)) (setq vdist (/ (- (cadr pt1) (cadr pt2)) 2.0)) (setq pt1 (mapcar '+ pt1 (list 10.0 vdist 0.0))) (setq pt2 (list (nth 3 pts)(nth 4 pts) 0.0)) (setq pt2 (mapcar '+ pt2 (list (- 10.0) vdist 0.0))) (command "line" pt1 pt2 "") (command "chprop" (entlast) "" "la" llayer "") (setq acm (vla-getinterfaceobject (vlax-get-acad-object) (strcat "Autocad.AcCmcolor." (substr (getvar 'acadver) 1 2)))) (vla-put-colorindex acm lcol) (vla-setcellbackgroundcolor objtable row 2 acm) (princ) ) (defun ahmktable ( numr / colwidth numcolumns numrows rowheight sp vgad vgao vgms) (vl-load-com) (setq sp (vlax-3d-point (getpoint "select point for table"))) (Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) ; (setq numrows numr) (setq numcolumns 7) (setq rowheight 40) (setq colwidth 200) (setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "KALIP METRAJ [ m² ]"); TABLE TITLE (vla-settext objtable 1 0 "NO") (vla-settext objtable 1 1 "LINETYPE") (vla-settext objtable 1 2 "COLOR") (vla-settext objtable 1 3 "LAYER NAME") (vla-settext objtable 1 4 "LENGTH") (vla-settext objtable 1 5 "HEIGHT") (vla-settext objtable 1 6 "AREA") (vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) 12) (vla-Setcolumnwidth Objtable 0 50) (vla-Setcolumnwidth Objtable 1 100) (vla-Setcolumnwidth Objtable 2 100) (vla-Setcolumnwidth Objtable 3 400) (vla-Setcolumnwidth Objtable 4 100) (vla-Setcolumnwidth Objtable 5 100) (vla-Setcolumnwidth Objtable 6 150) (princ) ) (defun c:klp ( / a i s ent lay ht objtable lst lst2 lst3 x voltot num row col) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (prompt "select plines") (setq s (ssget (list (cons 0 "LWPOLYLINE,LINE,ARC")))) (setq lst '()) (repeat (setq x (sslength s)) (setq ent (entget (ssname s (setq x (- x 1))))) (setq lay (cdr (assoc 8 ent))) (setq lst (cons lay lst)) ) (setq lst (vl-sort lst '(lambda (x y) (< x y)))) (setq lst3 '()) (setq x 0) (repeat (-(length lst) 1) (if (= (nth x lst)(nth (setq x (+ x 1)) lst)) (princ ) (setq lst3 (cons (nth (- x 1) lst) lst3)) ) ) (setq lst3 (cons (nth (-(length lst) 1) lst) lst3)) (setq lst2 '()) (repeat (setq x (length lst3)) (setq lay (nth (setq x (- x 1)) lst3)) (setq ht (/ (nth 0 (LM:parsenumbers lay)) 1.0)) (if (= (substr lay 1 1) "H")(setq ht (abs ht))) (if s (progn (setq a 0.0) (repeat (setq i (sslength s)) (setq e (ssname s (setq i (1- i)))) (if (= lay (cdr (assoc 8 (entget e)))) (progn (setq a (+ a (vla-get-length (vlax-ename->vla-object e)))) (setq col (vla-get-color (vlax-ename->vla-object e))) (if (= col 256) (setq col (cdr (assoc 62 (tblsearch "LAYER" lay)))) ) ) ) ) (setq a (/ a 100)) ) ) (setq lst2 (cons (list lay a ht col) lst2)) ) (ahmktable (+ (length lst2) 3)) (setq voltot 0) (setq num 1) (setq row 2) (setq i 0) (repeat (setq x (length lst2)) (setq itlst (nth i lst2)) (vla-settext objtable row 0 (rtos num 2 0)) (vla-settext objtable row 3 (nth 0 itlst)) (vla-settext objtable row 4 (rtos (nth 1 itlst) 2 3)) (vla-settext objtable row 5 (rtos (nth 2 itlst) 2 3)) (vla-settext objtable row 6 (rtos (*(nth 1 itlst)(nth 2 itlst)) 2 3)) ;(alert "color is nth 3") (ahdodrawline (nth 0 itlst) row (nth 3 itlst)) (setq num (1+ num)) (setq voltot (+ (* (nth 1 itlst)(nth 2 itlst)) voltot)) (setq row (+ row 1)) (setq i (+ i 1)) ) (vla-mergecells objtable (+ (length lst2) 2) (+ (length lst2) 2) 0 5) (vla-settext objtable (+ (length lst2) 2) 0 "TOTAL AREA ") (vla-settext objtable (+ (length lst2) 2) 6 (rtos voltot 2 3)) (princ) ) (C:KLP) Edited April 3, 2023 by BIGAL Quote Link to comment Share on other sites More sharing options...
hamit Posted March 31, 2023 Share Posted March 31, 2023 Thank you for your interest, Mr. Bigal. Lisp works, but as you said, it only shows 1 layer. Is it possible to see all layers in the table at the same time? Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 1, 2023 Share Posted April 1, 2023 Post a dwg with multiple layers I think there is a bug in the original code not what I added. Quote Link to comment Share on other sites More sharing options...
hamit Posted April 1, 2023 Share Posted April 1, 2023 (edited) Bigal Bey, the project with more than one layer is attached. The last code you posted was not subtotaling the fields. TEST 2.dwg Edited April 1, 2023 by hamit Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 2, 2023 Share Posted April 2, 2023 Wiil have a look I only added color and linetype so will see what original code does on a multi layer dwg. It may be totaling column 5 instead of column 7. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 3, 2023 Share Posted April 3, 2023 (edited) Updated code please try. ; https://www.cadtutor.net/forum/topic/77165-can-you-help-about-lisp/ ;;---------------------=={ Total Area }==---------------------;; ;; ;; ;; Displays the total area of selected objects at the ;; ;; command line. The precision of the printed result is ;; ;; dependent on the setting of the LUPREC system variable. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ; Total area modified by Alanh to allow multiple pick by layer ; uses height in layer name for volume expect metric ; Nov 2019 ; Added Linetype in cell ; Added color of layer to cell ; By AlanH April 2023 ;; Parse Numbers - Lee Mac ;; Parses a list of numerical values from a supplied string. ;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;------------------------------------------------------------;; (defun LM:parsenumbers ( str ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar '(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) '(())) ) ) ")" ) ) ) (vl-string->list str) ) ) (defun ahdodrawline (llayer crow lcol / pt pt1 pt2 vdist acm ) (setq pts (vlax-safearray->list (vlax-variant-value (VLA-GETCELLEXTENTS objtable (+ crow 1) 1 :vlax-false)))) (setq pt1 (list (nth 0 pts)(nth 1 pts) 0.0)) (setq pt2 (list (nth 6 pts)(nth 7 pts) 0.0)) (setq vdist (/ (- (cadr pt1) (cadr pt2)) 2.0)) (setq pt1 (mapcar '+ pt1 (list 10.0 vdist 0.0))) (setq pt2 (list (nth 3 pts)(nth 4 pts) 0.0)) (setq pt2 (mapcar '+ pt2 (list (- 10.0) vdist 0.0))) (command "line" pt1 pt2 "") (command "chprop" (entlast) "" "la" llayer "") (setq acm (vla-getinterfaceobject (vlax-get-acad-object) (strcat "Autocad.AcCmcolor." (substr (getvar 'acadver) 1 2)))) (vla-put-colorindex acm lcol) (vla-setcellbackgroundcolor objtable row 2 acm) (princ) ) (defun ahmktable ( numr / colwidth numcolumns numrows rowheight sp vgad vgao vgms) (vl-load-com) (setq sp (vlax-3d-point (getpoint "select point for table"))) (Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) ; (setq numrows numr) (setq numcolumns 7) (setq rowheight 40) (setq colwidth 200) (setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "KALIP METRAJ [ m² ]"); TABLE TITLE (vla-settext objtable 1 0 "NO") (vla-settext objtable 1 1 "LINETYPE") (vla-settext objtable 1 2 "COLOR") (vla-settext objtable 1 3 "LAYER NAME") (vla-settext objtable 1 4 "LENGTH") (vla-settext objtable 1 5 "HEIGHT") (vla-settext objtable 1 6 "AREA") (vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) 12) (vla-Setcolumnwidth Objtable 0 50) (vla-Setcolumnwidth Objtable 1 100) (vla-Setcolumnwidth Objtable 2 100) (vla-Setcolumnwidth Objtable 3 400) (vla-Setcolumnwidth Objtable 4 100) (vla-Setcolumnwidth Objtable 5 100) (vla-Setcolumnwidth Objtable 6 150) (princ) ) (defun c:klp ( / a i s ent lay ht objtable lst lst2 lst3 x voltot num row col) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (prompt "select plines") (setq s (ssget (list (cons 0 "LWPOLYLINE,LINE,ARC")))) (setq lst '()) (repeat (setq x (sslength s)) (setq ent (entget (ssname s (setq x (- x 1))))) (setq lay (cdr (assoc 8 ent))) (setq lst (cons lay lst)) ) (setq lst (vl-sort lst '(lambda (x y) (< x y)))) (setq lst3 '()) (setq x 0) (repeat (-(length lst) 1) (if (= (nth x lst)(nth (setq x (+ x 1)) lst)) (princ ) (setq lst3 (cons (nth (- x 1) lst) lst3)) ) ) (setq lst3 (cons (nth (-(length lst) 1) lst) lst3)) (setq lst2 '()) (repeat (setq x (length lst3)) (setq lay (nth (setq x (- x 1)) lst3)) (setq ht (/ (nth 0 (LM:parsenumbers lay)) 1.0)) (if (= (substr lay 1 1) "H")(setq ht (abs ht))) (if s (progn (setq a 0.0) (repeat (setq i (sslength s)) (setq e (ssname s (setq i (1- i)))) (if (= lay (cdr (assoc 8 (entget e)))) (progn (setq a (+ a (vla-get-length (vlax-ename->vla-object e)))) (setq col (vla-get-color (vlax-ename->vla-object e))) (if (= col 256) (setq col (cdr (assoc 62 (tblsearch "LAYER" lay)))) ) ) ) ) (setq a (/ a 100)) ) ) (setq lst2 (cons (list lay a ht col) lst2)) ) (ahmktable (+ (length lst2) 3)) (setq voltot 0) (setq num 1) (setq row 2) (setq i 0) (repeat (setq x (length lst2)) (setq itlst (nth i lst2)) (vla-settext objtable row 0 (rtos num 2 0)) (vla-settext objtable row 3 (nth 0 itlst)) (vla-settext objtable row 4 (rtos (nth 1 itlst) 2 3)) (vla-settext objtable row 5 (rtos (nth 2 itlst) 2 3)) (vla-settext objtable row 6 (rtos (*(nth 1 itlst)(nth 2 itlst)) 2 3)) ;(alert "color is nth 3") (ahdodrawline (nth 0 itlst) row (nth 3 itlst)) (setq num (1+ num)) (setq voltot (+ (* (nth 1 itlst)(nth 2 itlst)) voltot)) (setq row (+ row 1)) (setq i (+ i 1)) ) (vla-mergecells objtable (+ (length lst2) 2) (+ (length lst2) 2) 0 5) (vla-settext objtable (+ (length lst2) 2) 0 "TOTAL AREA ") (vla-settext objtable (+ (length lst2) 2) 6 (rtos voltot 2 3)) (setvar 'osmode oldsnap) (princ) ) (C:KLP) Some areas are -ve are they meant to be added to total as a positive number ? Edited April 11, 2023 by BIGAL Quote Link to comment Share on other sites More sharing options...
hamit Posted April 3, 2023 Share Posted April 3, 2023 (edited) Mr. Bigal, your work has been great.congratulations.fields will not be added to the sum positive.now the lisp is working perfectly.if it is poyline in the project, it assigns it as a line to the linetype section of the table.polyline in the project and polyline in the table.can this be done? It also resets the osnap settings settings. Can this be fixed? Edited April 3, 2023 by hamit Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 4, 2023 Share Posted April 4, 2023 Change this forgot to do it down at end of code. (vla-settext objtable (+ (length lst2) 2) 6 (rtos voltot 2 3)) (setvar 'osmode oldsnap) (princ) Quote Link to comment Share on other sites More sharing options...
hamit Posted April 4, 2023 Share Posted April 4, 2023 Hello ; First of all, thank you for your attention. I still have the problem of closing the osnap settings when Lisp is running. Also, I request that the polylines in the orije be thrown into the table as polylines, not lines. Quote Link to comment Share on other sites More sharing options...
hamit Posted April 10, 2023 Share Posted April 10, 2023 Mr. bigal. Can you help me with my latest writings? Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.