Rotina para levantamento do comprimento de linhas por layer

Informações sobre aplicativos relacionado a área de elétrica.

Moderador: Moderadores

Avatar do usuário
condevalder
Madeira
Madeira
Mensagens: 16
Registrado em: Qui 22 Set 2005 12:00:00 am

Rotina para levantamento do comprimento de linhas por layer

Mensagem por condevalder »

Ola amigos !

Estou precisando de uma rotina que faça o levantamento do comprimento das linhas por layer, e insira estes valores e nome da layer em um quadro ou legenda.

Ficarei grato se alguem puder me ajudar, pois não entendo nada de Autolisp.
Avatar do usuário
hugopaulo
Master
Master
Mensagens: 1873
Registrado em: Dom 29 Fev 2004 12:00:00 am

Mensagem por hugopaulo »

E aí Conde ???

Tás com problema de óculos ??? Vide abaixo o mesmo tópico já com resposta do Mestre Rogério !

[]'s
hugopaulo
AutoLISP Não É LISP ==> VISUAL LISP não é Linguagem
Avatar do usuário
Rogerio
Master
Master
Mensagens: 2034
Registrado em: Ter 23 Mar 2004 12:00:00 am

Mensagem por Rogerio »

Mestre??? Muito honrado, mas é honra demais.

Apenas ajudei.

Quanto a colocar em uma tabela, é um pouco mais complicado, creio.

O link pra rotina é:

http://www.autolisp.com.br/autolisp/mod ... =7370#7370

Bem, uma idéia pra fazer uma tabela rápida seria usar Tbox para cada linha de texto
(na verdade, cada par de string, o LAYER e o CPTO.), e alinhar essas Tbox. Teria também que especificar o comprimento máximo de cada string para adicionar espaços, de modo que os Textbox fiquem do mesmo tamanho.


Se alguém quiser desenvolver a idéia. Eu realmente não sei traduzir isso pra autolisp.

Alguém se habilita?

[],

Rogério
Avatar do usuário
Rogerio
Master
Master
Mensagens: 2034
Registrado em: Ter 23 Mar 2004 12:00:00 am

Mensagem por Rogerio »

Hugo, valeu pelo elogio, mas é muito pra mim, he he he.

Você, o Neyton, o Craksther e outros sabem muito mais que eu.

Sou só um aprendiz, qurendo aprender sempre, aos poucos.

[],

Rogério
Avatar do usuário
Rogerio
Master
Master
Mensagens: 2034
Registrado em: Ter 23 Mar 2004 12:00:00 am

Mensagem por Rogerio »

Cara, eu até tentei, mas ainda vai demorar um pouco pra eu aprender mais.

Depois eu posto a rotina que eu tenho na cabeça, mas vou precisar de umas ajudas pra completar, porém o básico eu tenho na mente.

Eu tenho o carro, só falta o motor, he he he.

Segue a rotina pra tabela.

Créditos: Fatty e Jeff Mishler, do Autodesk Discussion Groups.

A minha eu posto depois, se eu conseguir acabar, he he he.

Cada dia eu sou mais entusiasta do magic-autolisp.


(defun C:lrt (/ acsp ac_table adoc col col_names col_num
data data_list header_txt_hgt max_1_wid
max_2_wid max_wid pin row row_hgt row_num txt_hgt)
;----------------------------------------------
(defun lenbylay (/ lay doc ss len )
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(while (setq lay (tblnext "LAYER" (not lay)))
(if (ssget "x" (list (cons 0 "LINE,POLYLINE,LWPOLYLINE") (cons 8 (cdr (assoc 2 lay)))))
(progn
(setq ss (vla-get-activeselectionset doc)
len 0.0)
(vlax-for ent ss
(setq len (+ (vla-get-length ent) len))
)
(setq totals (cons (cons (cdr (assoc 2 lay)) len) totals))
)
)
)
totals
)
;----------------------------------------------
(lenbylay);;execute function to get LAYERS+LENGTH
;----------------------------------------------
(vl-load-com)
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
)
(vla-endundomark
adoc)
(vla-startundomark
adoc)
(setq lup (getvar "lunits"))
(setvar "lunits" 2);metric units
(setq lpc (getvar "luprec"))
(setvar "luprec" 3);precision
(setq dmz (getvar "dimzin"))
(setvar "dimzin" 8);suppress zeros for primary unit
(setq pin (vlax-3d-point
(getpoint "\nSpecify table insertion point : \n"))
row_hgt (getreal "\nSpecify row height : \n")
header_txt_hgt (getreal "\nSpecify header text height : \n")
txt_hgt (getreal "\nSpecify cell text height : \n"))
(setq header "Your header here" col_names (list "Layer" "Length"))

;(setq data_list
;'(("FABRICA" . 293.196) ("FORMATO" . 339.512) ("LIX" . 1263.56) ("F" . 944.097)
;("CONTORNO" . 1350.37) ("0" . 621.266))

(setq data_list totals ;totals contain a list
max_1_wid (apply 'max (mapcar 'strlen (mapcar 'car data_list)))
max_2_wid (apply 'max (mapcar 'strlen (mapcar 'rtos (mapcar 'cdr data_list))))
max_wid (* 1.25 (apply 'max (list max_1_wid max_2_wid)))
data_list (list (mapcar 'car data_list)
(mapcar 'rtos (mapcar 'cdr data_list))))

(setq ac_table (vla-addtable acsp pin
(+ (length (car data_list)) 2)
(length col_names)
row_hgt
(* txt_hgt max_wid))
)
(vla-settext ac_table 0 0 header)
(vla-setcellalignment ac_table 0 0 acmiddlecenter)
(vla-setcelltextheight ac_table 0 0 header_txt_hgt)
(vla-setrowheight ac_table 0 (* header_txt_hgt 2))
(setq col 0)

(foreach item col_names
(vla-settext ac_table 1 col item)
(vla-setcellalignment ac_table 1 col acmiddlecenter)
(vla-setcelltextheight ac_table 1 col txt_hgt)
(setq col (1+ col)))

(setq row 2
col 0
row_num (length (car data_list))
col_num (length col_names))
(repeat col_num
(setq data (car data_list))
(repeat row_num
(vla-settext ac_table row col (car data))
(vla-setcellalignment ac_table row col acmiddlecenter)
(vla-setcelltextheight ac_table row col txt_hgt)
(setq data (cdr data))
(setq row (1+ row)))
(setq col (1+ col) row 2)
(setq data_list (cdr data_list))
)
(setvar "luprec" lpc)
(setvar "lunits" lup)
(setvar "dimzin" dmz)
(setq totals nil)
(vla-endundomark
adoc)
(princ)
)

{},

Rogério
Avatar do usuário
Rogerio
Master
Master
Mensagens: 2034
Registrado em: Ter 23 Mar 2004 12:00:00 am

Mensagem por Rogerio »

Faltou o tratamento de erro. Seria perfeita se tivesse.

{},

Rogério
Avatar do usuário
Rogerio
Master
Master
Mensagens: 2034
Registrado em: Ter 23 Mar 2004 12:00:00 am

Mensagem por Rogerio »

Adicionei uma função para deixar os nomes dos Layers com caixa alta.


(defun C:lrt (/ acsp ac_table adoc col col_names col_num
data data_list header_txt_hgt max_1_wid
max_2_wid max_wid pin row row_hgt row_num txt_hgt)
;----------------------------------------------
(defun capLayers ()
(vlax-map-collection
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)))
'(lambda (x)
(vla-put-name x (strcase (vla-get-name x))))
)
(princ)
)
;----------------------------------------------
(defun lenbylay (/ lay doc ss len )
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(while (setq lay (tblnext "LAYER" (not lay)))
(if (ssget "x" (list (cons 0 "LINE,POLYLINE,LWPOLYLINE") (cons 8 (cdr (assoc 2 lay)))))
(progn
(setq ss (vla-get-activeselectionset doc)
len 0.0)
(vlax-for ent ss
(setq len (+ (vla-get-length ent) len))
)
(setq totals (cons (cons (cdr (assoc 2 lay)) len) totals))
)
)
)
totals
)
;----------------------------------------------
(lenbylay);;execute function to get LAYERS+LENGTH
(capLayers);;execute Uppercase in layes table
;----------------------------------------------
(vl-load-com)
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
)
(vla-endundomark
adoc)
(vla-startundomark
adoc)
(setq lup (getvar "lunits"))
(setvar "lunits" 2);metric units
(setq lpc (getvar "luprec"))
(setvar "luprec" 3);precision
(setq dmz (getvar "dimzin"))
(setvar "dimzin" 8);suppress zeros for primary unit
(setq pin (vlax-3d-point
(getpoint "\nSpecify table insertion point : \n"))
row_hgt (getreal "\nSpecify row height : \n")
header_txt_hgt (getreal "\nSpecify header text height : \n")
txt_hgt (getreal "\nSpecify cell text height : \n"))
(setq header "Your header here" col_names (list "Layer" "Length"))

(setq data_list totals ;totals contain a list
max_1_wid (apply 'max (mapcar 'strlen (mapcar 'car data_list)))
max_2_wid (apply 'max (mapcar 'strlen (mapcar 'rtos (mapcar 'cdr data_list))))
max_wid (* 1.25 (apply 'max (list max_1_wid max_2_wid)))
data_list (list (mapcar 'car data_list)
(mapcar 'rtos (mapcar 'cdr data_list))))

(setq ac_table (vla-addtable acsp pin
(+ (length (car data_list)) 2)
(length col_names)
row_hgt
(* txt_hgt max_wid))
)
(vla-settext ac_table 0 0 header)
(vla-setcellalignment ac_table 0 0 acmiddlecenter)
(vla-setcelltextheight ac_table 0 0 header_txt_hgt)
(vla-setrowheight ac_table 0 (* header_txt_hgt 2))
(setq col 0)

(foreach item col_names
(vla-settext ac_table 1 col item)
(vla-setcellalignment ac_table 1 col acmiddlecenter)
(vla-setcelltextheight ac_table 1 col txt_hgt)
(setq col (1+ col)))

(setq row 2
col 0
row_num (length (car data_list))
col_num (length col_names))
(repeat col_num
(setq data (car data_list))
(repeat row_num
(vla-settext ac_table row col (car data))
(vla-setcellalignment ac_table row col acmiddlecenter)
(vla-setcelltextheight ac_table row col txt_hgt)
(setq data (cdr data))
(setq row (1+ row)))
(setq col (1+ col) row 2)
(setq data_list (cdr data_list))
)
(setvar "luprec" lpc)
(setvar "lunits" lup)
(setvar "dimzin" dmz)
(setq totals nil)
(vla-endundomark
adoc)
(princ)
)
Avatar do usuário
Rogerio
Master
Master
Mensagens: 2034
Registrado em: Ter 23 Mar 2004 12:00:00 am

Mensagem por Rogerio »

Mais uma.

Quero deixar aqui eu reconhecimento aos programadores de autolisp, tanto brasileiros como os estrangeiros.

Não vou dizer os nomes, pois posso esquecer de alguém.

Mas o que é feito com autolisp é digno de adimiração. Acho que é por isso meu entusiasmo pelo assunto.

Segue mais uma rotina que exporta os respectivos perímetros de cada layer para uma planilha Excel.

Modifiquem a seu critério.

Créditos na rotina, e ao meu amigo Fatty também.

O comando inicial é Excel, e a rotina funciona automaticamente ao carregar.

Testada com Autocad 2005.

{},

Rogério


;; this file was done by FATTY , if you want to contac me do it at

;; devitg@gmail.com.
;; I'm from Cordoba Argentina

(defun get-poly-lens-by-layer (/ acsp adoc ca-sel lay_len len
lst_lay lst_sum ss sum_tot_len tmp)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq acsp (vla-get-block (vla-get-activelayout adoc)))
(setq lst_lay ())
(vlax-for a (vla-get-layers adoc)
(setq lst_lay (cons (vla-get-name a) lst_lay))
)
(setq lst_lay (acad_strlsort lst_lay))
(if (setq ss (ssget "_X" '((0 . "*LINE,CIRCLE,ARC"))))
(progn
(setq ca-sel (vla-get-activeselectionset adoc))
(vlax-for a ca-sel
(setq len (vlax-curve-getdistatparam a
(vlax-curve-getendparam a)))
(setq lst_sum (cons (cons (vla-get-layer a) len) lst_sum)))
(setq tmp nil lay_len nil sum_tot_len nil)
(foreach a lst_sum (setq tmp (vl-remove-if (function (lambda (a)
(not (eq (car a)(car lst_lay )) ))) lst_sum))
(setq lay_len (cons (list (car lst_lay) (apply '+ (mapcar 'cdr tmp))) lay_len))
(setq tmp nil)
(setq sum_tot_len (append lay_len sum_tot_len))
(setq lay_len nil)
(setq lst_lay (cdr lst_lay))
)
(setq sum_tot_len (vl-remove-if (function (lambda (a)
(zerop (cadr a)))) sum_tot_len))))
sum_tot_len
)




;CaLLget-poly-lens-by-layer)
(defun c:Excel (/ ;|LAYER# LIST# N ROW TOTALVALUE VALUE|;)
;;;; DESARROLLO DE PROGRAMAS PARA CONSTRUCCION-ALEJANDRO LEGUIZAMON- arquingeneu@gmail.com
;;;;; traducido con permiso del autor por DEVITG@GMAIL.COM
;;; TRANSLATED WITH AUTHOR'S PERMISSION

;;;****************************************************************************;
;;; | Mis apologias al autor del programa ALEJANDRO LEGUIZAMON para corregir |;
;;;****************************************************************************;
(vl-load-com)
(setq *AplExcel* (vlax-get-or-create-object "excel.application")
*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)
*excell-cells* (vlax-get-property *Sheet#1* "Cells")
);_end setq
(vla-put-visible *AplExcel* :vlax-true)
(setq row 4)
(setq n 0)
(setq totalvalue 0)
(princ "\nSelect polylines to size... ")

;;; (setq selection (ssget ))
;;; (setq quantity (sslength selection))
;;; (repeat quantity
;;; (setq name (ssname selection n))
;;; (setq end (vlax-curve-getendparam name))
;;; (setq start (vlax-curve-getStartParam name))
;;; (setq end-point (vlax-curve-getEndPoint name))
;;; (setq length# (vlax-curve-getDistAtPoint name end-point))
;;; (setq value length#)
;;; (setq totalvalue (+ totalvalue value))
(setq list# (get-poly-lens-by-layer))

(setq totalvalue (apply '+ (mapcar 'cadr list#)))
(repeat (length list#)
(setq value (cadar list#))
(vlax-put-property
*excell-cells*
"Item"
row
2
(vl-princ-to-string value)
)
;;; (setq list# (entget name))
(setq layer# (caar list#))
;;; (SETQ point# (ASSOC 10 list#))
;;; (setq x (cadr point#))
;;; (setq y (caddr point#))
;;(command "_zoom" "c" (list x y) "5")
(vlax-put-property
*excell-cells*
"Item"
row
1
(vl-princ-to-string layer#)
)en- vlax-put-property
(setq list# (cdr list#))
(setq n (+ n 1))
(setq row (+ row 1))
);_end repeat

(setq row (+ row 1));_add a row to locate the total value

(vlax-put-property
*excell-cells*
"Item"
row
1
(vl-princ-to-string "total length")
)en- vlax-put-property

(vlax-put-property
*excell-cells*
"Item"
row
2
(vl-princ-to-string totalvalue)
)en- vlax-put-property

(vlax-put-property
*excell-cells*
"Item"
1
1
(vl-princ-to-string
"Rutina Autolisp para calculo de length# - ALEJANDRO LEGUIZAMON - http://arquingen.tripod.com.co--modif por DEVITG"
);_end vl-princ-to-string
);_end vlax-put-property

(vlax-put-property
*excell-cells*
"Item"
2
1
(vl-princ-to-string
" Autolisp routine to calculate the length of selected polylines - by ALEJANDRO LEGUIZAMON - http://arquingen.tripod.com.co--modif by DEVITG@gmail.com"
);_end vl-princ-to-string
);_end vlax-put-property
(vlax-put-property
*excell-cells*
"Item"
3
1
(vl-princ-to-string "LAYER")
)
(vlax-put-property
*excell-cells*
"Item"
3
2
(vl-princ-to-string "LENGTH")
)

(vlax-release-object *excell-cells*)
(vlax-release-object *Sheet#1*)
(vlax-release-object *Sheet-Collection*)
(vlax-release-object *New-Book*)
(vlax-release-object *Books-Colection*)
(vlax-release-object *AplExcel*)
)

(c:excel)
Avatar do usuário
Rogerio
Master
Master
Mensagens: 2034
Registrado em: Ter 23 Mar 2004 12:00:00 am

Mensagem por Rogerio »

Quem quiser, adicione a função abaixo depois de c:excel, para deixar os nomes dos layers com caixa alta.
;----------------------------------------------
(defun capLayers ()
(vlax-map-collection
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)))
'(lambda (x)
(vla-put-name x (strcase (vla-get-name x))))
)
(princ)
)
(capLayers)
;----------------------------------------------

{},

Rogerio
Avatar do usuário
condevalder
Madeira
Madeira
Mensagens: 16
Registrado em: Qui 22 Set 2005 12:00:00 am

Mensagem por condevalder »

Rogério !

Estou imesamente agradecido a você, não sei como retribuir a ajuda..........
Sou totalmente ignorante no que diz respeito à programação em autolisp, mas tenho 9 anos de experiencia em autocad, caso precise de alguma coisa é só pedir.

À proposito a rotina funcionou direitinho no Autocad 2006.

CondeValder
Responder