CAN YOU HELP ABOUT LISP

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

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.

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.

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

March 23, 2023

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

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

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.

March 25, 2023

Mr. Bigal we are waiting for your help

March 25, 2023

I will have time today to try and do something.

March 30, 2023

Can you help with this lisp

March 31, 2023

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

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?

April 1, 2023

Post a dwg with multiple layers I think there is a bug in the original code not what I added.

April 1, 2023

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

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.

April 3, 2023

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

April 3, 2023

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

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)

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.

April 10, 2023

Mr. bigal. Can you help me with my latest writings?

Sign In

CAN YOU HELP ABOUT LISP

Recommended Posts

hmtpk

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

BIGAL

BIGAL

Posted Images

BIGAL

hmtpk

devitg

BIGAL

devitg

BIGAL

hmtpk

BIGAL

hamit

BIGAL

hamit

BIGAL

hamit

BIGAL

BIGAL

hamit

BIGAL

hamit

hamit

Join the conversation

BIGAL

BIGAL

Tutorials

Forums

Activity