Jump to content

Help on code for quantity list by layer...

m1r

By m1r
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

m1r Apprentice

m1r

Posted
Posted (edited)

First of all, congrats on this nice forum and was i can tell a nice community.

 

I need some help with a lisp code, because i can understand some of the code but in reality im a copy e paste "coder" :lol: ...

The code im sending its a compilation of some free lips i found and i tweak it to fit my own meanings.

The purpose of this, is to make a excel sheet with the distance for all lines, polylines, arc's i select in an drawing by layer. But I have a error on the code and i don't know how to fix it, the lisp is getting all the distances of my selection for polylines and arc's, but when i select just lines the result i'm getting its the distance for all the lines in the drawing, i need to narrow the result just to the objects i selected.

Can u help with this? Many thanks

 

(defun c:medz (/	elist	 en	  i	   layer    layer_list
	leng	 pline	  row	   ss	    sumlen   total
	x	 xlApp	  xlBook   xlBooks  xlCells  xlSheet
	xlSheets
       )
 (vl-load-com)
 (setq	xlApp	   (vlax-get-or-create-object "Excel.Application")
xlBooks  (vlax-get-property xlApp "Workbooks")
xlBook	   (vlax-invoke-method xlBooks "Add")
xlSheets (vlax-get-property xlBook "Sheets")
xlSheet	   (vlax-get-property xlSheets "Item" 1)
xlCells	   (vlax-get-property xlSheet "Cells")
 ) 
 (vla-put-visible xlApp :vlax-true)
 ;headers
 (vlax-put-property xlCells "Item" 1 1 "Layer")
 (vlax-put-property xlCells "Item" 1 2 "Length")
 
 (setq row 2
total 0)

 (setq ss (ssget (list (cons 0 "*POLYLINE,*LINE,*ARC"))) i -1)
 (repeat (sslength ss)
   (setq en (ssname ss (setq i (1+ i)))
  elist (entget en)
  layer (cdr (assoc 8 elist)))
   (if (not (member layer layer_list))
     (setq layer_list (cons layer layer_list))))
 
 
 (repeat (length layer_list)
   (setq layer (car layer_list))
   (setq ss (ssget "_X" (list (cons 0 "*POLYLINE,*LINE,*ARC")(cons 8 layer))) i -1 sumlen 0)
   (repeat (sslength ss)
   (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
   (setq leng  (vlax-curve-getdistatparam pline
	  (vlax-curve-getendparam pline)))
   (setq sumlen (+ sumlen leng)))
   (vlax-put-property xlCells "Item" row 1 layer)
   (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 0))
   (setq total (+ total sumlen))
;;;    (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3)); for metric units
   (setq layer_list (cdr layer_list))
   (setq row (+ row 1))
 ) 
 (setq row (+ row 1))
; footers:
(vlax-put-property xlCells "Item" row 1 "Total:")
(vlax-put-property xlCells "Item" row 2 (rtos total 2 0))
;;;(vlax-put-property xlCells "Item" row 2 (rtos total 2 3)); for metric units  

(mapcar (function (lambda(x)
	    (vl-catch-all-apply
	      (function (lambda()
			  (progn
			    (vlax-release-object x)
			    (setq x nil)))))))
(list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
)
(alert "Abriu automaticamente o Excel com as distancias pedidas")
(gc)(gc)
(princ)
 )
(princ "\t\t***\t  Escrever o comando medz, para correr a aplicação\t***")
(princ)

Edited by m1r
BIGAL Grand Master

BIGAL

Posted
Posted

Using the "X" filter means get all in a dwg this may be your problem.

hmsilva Proficient

hmsilva

Posted
Posted (edited)

... when i select just lines the result i'm getting its the distance for all the lines in the drawing, i need to narrow the result just to the objects i selected.

...

Hi m1r,

as BIGAL previously stated, with the second selection set, you'll select all dwg objects in the selected layers..

Try your code, slightly modified.

 

(defun c:medz (/ elist  en   i    layer    layer_list
 leng  pline   row    ss     sumlen   total
 x  xlApp   xlBook   xlBooks  xlCells  xlSheet
 xlSheets
       )
 (vl-load-com)
 (setq xlApp    (vlax-get-or-create-object "Excel.Application")
xlBooks  (vlax-get-property xlApp "Workbooks")
xlBook    (vlax-invoke-method xlBooks "Add")
xlSheets (vlax-get-property xlBook "Sheets")
xlSheet    (vlax-get-property xlSheets "Item" 1)
xlCells    (vlax-get-property xlSheet "Cells")
 ) 
 (vla-put-visible xlApp :vlax-true)
 ;headers
 (vlax-put-property xlCells "Item" 1 1 "Layer")
 (vlax-put-property xlCells "Item" 1 2 "Length")
 
 (setq row 2
total 0)
 (setq ss (ssget (list (cons 0 "*POLYLINE,*LINE,*ARC"))) i -1)
 (repeat (sslength ss)
   (setq en (ssname ss (setq i (1+ i)))
  elist (entget en)
  layer (cdr (assoc 8 elist)))
   (if (not (member layer layer_list))
     (setq layer_list (cons layer layer_list))))
 
 
 (repeat (length layer_list)
   (setq layer (car layer_list))
   ;; não é necessário, vai utilizar apenas a primeira ss
   ;(setq ss (ssget "_X" (list (cons 0 "*POLYLINE,*LINE,*ARC")(cons 8 layer)))
   (setq  i -1 sumlen 0)
   (repeat (sslength ss)
   (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
   (setq leng  (vlax-curve-getdistatparam pline
   (vlax-curve-getendparam pline)))
   ;; se pertencer ao mesmo layer adiciona o comprimento
   (if (= (vla-get-layer pline) layer)
     (setq sumlen (+ sumlen leng))
)
     )
   (vlax-put-property xlCells "Item" row 1 layer)
   (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 0))
   (setq total (+ total sumlen))
;;;    (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3)); for metric units
   (setq layer_list (cdr layer_list))
   (setq row (+ row 1))
 ) 
 (setq row (+ row 1))
; footers:
(vlax-put-property xlCells "Item" row 1 "Total:")
(vlax-put-property xlCells "Item" row 2 (rtos total 2 0))
;;;(vlax-put-property xlCells "Item" row 2 (rtos total 2 3)); for metric units  
(mapcar (function (lambda(x)
     (vl-catch-all-apply
       (function (lambda()
     (progn
       (vlax-release-object x)
       (setq x nil)))))))
(list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
)
(alert "Abriu automaticamente o Excel com as distancias pedidas")
(gc)(gc)
(princ)
 )
(princ "\t\t***\t  Escrever o comando medz, para correr a aplicação\t***")
(princ)

 

Hope that helps

Henrique

Edited by hmsilva
VVA Rising Star

VVA

Posted
Posted

Try it (MLEN41 or MAREA42)

(VL-LOAD-COM)
(defun c:mlen41 (/ m ss clist temp)
;_Command MLEN41
;http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=20298&PAGEN_1=3

 (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 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 a 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 linear primitives in layers:"
   )
   (setq temp (mapcar 'mlen4_1 clist))
   (xls temp '("Layer" "Length") nil "mlen41")
 )
 (princ)
) ;_  defun

(defun c:MAREA42 (/ m ss clist temp)
;_Command MAREA42   
;_Counts the area a closed contour   
;http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=20298&PAGEN_1=3
; 
 (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 mlen4_1 (lst / sum_area) 
   (setq sum_area 0) 
   (foreach item (mapcar 'car lst) 
     (setq sum_area  (+ sum_area 
      (if (and 
       (vlax-property-available-p item 'area) 
       (or 
         (vlax-curve-isClosed item) 
         (equal 
      (vlax-curve-getStartPoint item) 
      (vlax-curve-getEndPoint item) 
      1e-6 
      ) 
         ) 
       ) 
        (vla-get-area item) 
        0 
      ) ;_  if 
   ) ;_  + 
     ) 
   ) 
   (if  (not (zerop sum_area)) 
     (princ 
 (strcat "\n\t" (cdar lst) " = " (rtos (* sum_area m) 2 4)) 
     ) 
   ) 
   (list (cdar lst)(rtos (* sum_area m) 2 4)) 
 ) 
 (vl-load-com) 
 (if (null *M*)(setq *M* 1)) 
 (initget 6) 
 (and 
   (princ "\nEnter a 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 area of all linear primitives in layers:" 
   ) 
   (setq temp (mapcar 'mlen4_1 clist)) 
   (xls temp '("Layer" "Area") nil "mlen42") 
 ) 
 (princ) 
) ;_  defun 


;|================== XLS ========================================
*  published http://forum.dwg.ru/showpost.php?p=244237&postcount=7
* Purpose: Export of the list of data Data-list in Excell
*             It is exported to a new leaf of the current book.
             If the book is not present, it is created
* Arguments:
             Data-list — The list of lists of data (LIST)
                           ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                           Each list of a kind (Value1 Value2... VlalueN) enters the name in
                           a separate line in corresponding columns (Value1-A Value2-B and .т.д.)
                 header —  The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
                           If header nil, is accepted ("X" "Y" "Z")
                Colhide —  The list of alphabetic names of columns to hide or nil — to not hide ("A" "C" "D") — to hide columns A, C, D
                Name_list — The name of a new leaf of the active book or nil — is not present
* Return: nil
* Usage
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3"  "Col4") '("B") "test")   |;

(vl-load-com)
(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))
(princ "\nType MLEN41 or MAREA42 in command line")(princ)

m1r Apprentice

m1r

Posted
  • Author
Posted

It worked like a charm Henrique, many thanks.

I knew that the error as on "_x" but the only Selection Mode Strings that worked was "_x" and "_a", in the rest of strings i was getting error's, now i realize that the code was wrong in first place, thank you for the correction, later on in gonna need some extra help, but for now i'm served.

 

Obrigado

Henrique

m1r Apprentice

m1r

Posted
  • Author
Posted
Using the "X" filter means get all in a dwg this may be your problem.

 

Yeap ur right BIGAL

Thanks

hmsilva Proficient

hmsilva

Posted
Posted
It worked like a charm Henrique, many thanks.

 

You're welcome, m1r

Glad I could help

 

Henrique

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...