Scribd
Upload
37 views

Lenght of Each Polyline by Layerwise in Table

Uploaded by

Aasdas
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
37 views

Lenght of Each Polyline by Layerwise in Table

Uploaded by

Aasdas
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 2

;;; Hatched area Table sorted by Layer with the Color markers

;;;
(Defun c:POLYLENGHT ( / AllData ss e edata Area_table crow bn area_ ssNH fname
clr )
(vl-load-com)
;;; pBe 23Apr2013 ;;;
;;; Mod for FSJ_Mo : Layer instead of Block swatches ;;;
;;; pBe 18Jul2013 ;;;
;;; karpki : Header by filename, m2 05/01/2020 ;;;
;;; Moded by hak_vz for karpki: color markers 12/01/2020 ;;;

(if
(setq AllData nil ssNH (ssadd)
ss (ssget '((0 . "POLYLINE,LWPOLYLINE")))
)
(progn
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
(setq edata
(list
(vlax-get e 'Layer)
(IF
(not
(vl-catch-all-error-p
(setq area_ (vl-catch-all-apply 'vla-get-length (list E)))
)
)
area_
(progn (ssadd (ssname ss i) ssNH) 0.0)
)
)
)
(setq AllData
(if (setq f (assoc (car edata) AllData))
(subst (list (car f) (+ (cadr f) (cadr edata))) f Alldata)
(cons edata AllData)
)
)
)
(setq AllData (vl-sort AllData '( lambda (m n) (< (Car m) (car n)))))
;cadr вместо car если нужна сортировка по площади; знак < указывает на сортировку
от меньшего к большему
(setq Area_table
(vlax-invoke
(vlax-get (vla-get-ActiveLayout
(vla-get-activedocument (vlax-get-acad-object))
)
'Block
)
'Addtable
(getpoint "\nPick point for Table:")
2 3 1500 7000
)
)
(setq fname(substr (setq str (getvar "dwgname")) 1 (- (strlen str) 4)))
;get Header name from file name
(vla-settext Area_table 0 0 fname)
;set header name
(vla-setcelltextheight Area_table 0 0 500.0)
(mapcar '(lambda (y)
(vla-settext Area_table 1 (car y) (cadr y))
(vla-setcelltextheight Area_table 1 (car y) 500.0)
;second row text height
)
(list '(0 "Category") '(1 "Total Length") '(2 "Colour"))
)
(foreach d AllData
(vla-insertrows
Area_table
(1+ (setq crow (vla-get-rows Area_table)))
1500
;cell height from 4-th row
1
)
(vla-setcelltextheight Area_table crow 0 500.0)
;set Layer name (Category)
(vla-setCellAlignment Area_table crow 0 5)
(vla-setCellValue Area_table crow 0 (car d))

(vla-setCellValue Area_table crow 1 (cadr d))


;set Area
(vla-setcelltextheight Area_table crow 1 500.0)
(vla-setCellAlignment Area_table crow 1 5)
(vla-setcellformat Area_table crow 1 "%lu2%pr3%ps[, m]")

;--------------
(setq x(strcat "AutoCAD.AcCmColor." (substr (getvar 'Acadver) 1 2)))
;set Color markers
(setq clr (vlax-create-object x))
(vla-put-colorindex clr (cdr (assoc 62 (tblsearch "layer" (car d)))))
(vla-SetCellBackgroundColor Area_table crow 2 clr)

;Possible editions if doesn't work :


;For Acad2015, use AutoCAD.AcCmColor.20
; - > (setq x "AutoCAD.AcCmColor.20")
;For Acad2016/17, use AutoCAD.AcCmColor.21
; - > (setq x "AutoCAD.AcCmColor.21")
;For Acad2018, use AutoCAd.AcCmColor.22
; - > (setq x "AutoCAD.AcCmColor.22")
;For Acad2019, use AutoCAD.AcCmColor.23
; - > (setq x "AutoCAD.AcCmColor.23")
;-------------------

)
)
)
(princ)
)

You might also like