- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I got a lisp code that can summarize polyline lengths Layer wise, but can’t summarize the polyline lengths from closed polygones separately. Suppose we have Zone-1, Zone-2, Zone-3 as closed polygons in their respective layers and then output lisp code should generate the polyline lengths inside the closed polygons as shown in attached Snapshot and cad file.
(defun c:mlen (/ m ss clist temp xls sort combine mlen4_1)
(defun sort (lst predicate)
(mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
)
(defun combine (inlist is-greater is-equal / sorted current result)
(setq sorted (sort inlist is-greater))
(setq current (list (car sorted)))
(foreach item (cdr sorted)
(if (apply is-equal (list item (car current)))
(setq current (cons item current))
(progn
(setq result (cons current result))
(setq current (list item))
)
)
)
(cons current result)
)
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
Res (strcat (chr (+ 64 TMP)) Res) N (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
(setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
(if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
(setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks")
*New-Book* (vlax-invoke-method *Books-Colection* "Add")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1* (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
(vl-filename-base(getvar "DWGNAME"))
(strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
(strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell 'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
(strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell 'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
(defun mlen4_1 (lst / sum_len)
(setq sum_len 0)
(foreach item (mapcar 'car lst)
(setq
sum_len (+ sum_len
(if (vlax-property-available-p item 'length)
(vla-get-length item)
(cond
((=
(strcase (vla-get-objectname item) t)
"acdbarc"
) ;_ =
(vla-get-arclength item)
)
((=
(strcase (vla-get-objectname item) t)
"acbcircle"
) ;_ =
(* pi 2.0 (vla-get-radius item))
)
(t 0.0)
) ;_ cond
) ;_ if
) ;_ +
)
)
(if (not (zerop sum_len))
(princ
(strcat "\n\t" (cdar lst) " = " (rtos (* sum_len m) 2 4))
)
)
(list (cdar lst)(rtos (* sum_len m) 2 4))
)
(vl-load-com)
(if (null *M*)(setq *M* 1))
(initget 6)
(and
(princ "\nEnter scale factor <")
(princ *M*)(princ ">: ")
(or (setq m (getreal))
(setq m *M*)
)
(setq *M* m)
(setq ss (ssget "_:L"))
(setq ss (mapcar
(function vlax-ename->vla-object)
(vl-remove-if
(function listp)
(mapcar
(function cadr)
(ssnamex ss)
) ;_ mapcar
) ;_ vl-remove-if
)
)
(mapcar '(lambda (x)
(setq temp (cons (cons x (vla-get-Layer x)) temp))
)
ss
)
(setq clist (combine temp
'(lambda (a b)
(> (cdr a) (cdr b))
)
'(lambda (a b)
(eq (cdr a) (cdr b))
)
)
)
(princ
"\n\n The total length of all line primitives by layers:"
)
(setq temp (mapcar 'mlen4_1 clist))
(xls temp '("Layer" "Length") nil "mlen41")
)
(princ)
) ;_ defun
I need polyline lengths as shown in attached image and cad file.
Regards,
T.Brahmanandam
Solved! Go to Solution.
