Programas que desenham por si!






20 November 2017

Bem-vindo, Visitante

Powered By

lusovps.com
Acesso de Visitante




Tem códigos para partilhar? Faça o seu registo e automáticamente pode disponibilizar os seus códigos!




Actualmente temos 12 dicas!

Procura Rápida->

Operação:

Tag:

Comandos Autolisp:

(1) append
(1) appendOuterLoop
(1) apply
(2) cons
(3) defun
(1) entsel
(1) function
(1) if
(1) lambda
(2) length
(2) list
(2) mapcar
(1) princ
(1) progn
(11) setq
(1) ssget
(2) ssname
(1) tblobjname
(1) tblsearch
(4) vl-load-com
(1) vl-sort-i
(2) vla-add
(2) vla-addcircle
(1) vla-AddHatch
(1) vla-addLightweightPolyline
(1) vla-addtable
(1) vla-addtext
(1) vla-delete
(1) vla-evaluate
(5) vla-get-ActiveDocument
(1) vla-get-activelayer
(1) vla-get-blocks
(1) vla-get-layers
(3) vla-get-ModelSpace
(1) vla-item
(1) vla-put-activelayer
(1) vla-put-Alignment
(1) vla-put-color
(1) vla-put-layer
(1) vla-put-TextAlignmentPoint
(1) vla-setText
(1) vlax-3d-point
(1) vlax-dump-object
(4) vlax-ename->vla-object
(6) vlax-get-Acad-Object
(3) vlax-get-property
(1) vlax-invoke
(2) vlax-make-safearray
(2) vlax-make-variant
(2) vlax-put-property
(2) vlax-safearray-fill
(1) vlax-true
(2) vlax-vbdouble
(1) vlax-vla-object->ename
Operação:Criar Tag:Table
Criar uma Table:

(setq myTable (vla-AddTable
*ms*
(vlax-3d-point pt1)
(+ 3 cnt)
3; numero de colunas columns
0.7 ; altura das linhas
2.5)) ;largura das colunas
; Definir titulo da tabela
(vla-setText mytable 0 0 "Lista de Materiais")
; Definir titulos da colunas
(vla-setText mytable 1 0 "Numero")
(vla-setText mytable 1 1 "Descrição")
(vla-setText mytable 1 2 "Quantidade")
Comentar!Ver os 1 comentários
Operação:EffectiveName Propriedades Seleces Tag:Bloco
Tirar o nome do bloco:

(setq bloco (entsel "\n Seleccione o bloco:"))
(setq vlaxobj (vlax-ename->vla-object (car bloco)));
(setq nome_bloco (vlax-get-property vlaxobj "EffectiveName"))
(princ nome_bloco)
Comentar!Ver os 0 comentários


Operação:Propriedades ObjectName Tag:Polilinha
Neste exemplo explico como alternar entre entidades de lisp e entidades activex...

:::seleccionar um conjunto de objectos
(setq sel_eixo (ssget))

:::ir buscar a sua "identificação" activex
(setq my_vlaxobj (vlax-ename->vla-object (ssname sel_eixo 0)))

::: verificar por exemplo o tipo de objecto
(setq my_vlaxobj_name (vlax-get-property my_vlaxobj "ObjectName" ))

::: se for uma poli, continuamos...
(if (= vlaxobj_name "AcDbPolyline")(progn

(...)
))

::: para ter a identificação autolisp usamos

(setq my_lispobj (vlax-vla-object->ename my_vlaxobj))

Ou seja:

vlax-ename->vla-object ...... lisp -> activex
vlax-vla-object->ename ...... activex -> lisp

Comentar!Ver os 0 comentários
Operação:center width Alterar height activedocument Tag:View/Zoom
Alterar o "view" ou "Zoom":

(...)

(setq doc (vlax-get-property (vlax-get-acad-object) "activedocument")) ;documento atual
(setq viewP (vlax-ename->vla-object (tblobjname "view" "nome-da-view"))) ;view que deseja restaurar
(setq avp (vlax-get-property doc "activeviewport")) ;visualização atual
(vlax-put-property avp "center" (vlax-get-property viewP "center"));altera o centro
(vlax-put-property avp "width" (vlax-get-property viewP "width"));altera a largura
(vlax-put-property avp "height" (vlax-get-property viewP "height"));altera a altura
(vlax-put-property doc "activeviewport" avp) ;atualiza a vizualização

(...)

Comentar!Ver os 0 comentários


Operação:Listas Sub-rotinas Tag:
-> ORDENAR UMA LISTA DE LISTAS
-> ((23 abc)(15 def)(3 ghi)) --> ((3 ghi)(15 def)(23 abc))
-> devolve a mesma lista ordenada pelo indice 0 da sub lista

(defun bs:ord_lst_lst (lst_orig);
(setq lst_ord (vl-sort-i lst_orig(function (lambda (e1 e2)(< (nth 0 e1) (nth 0 e2)) ) ) )); obter a lista ordenada das posições
(setq lst_final (mapcar (function (lambda (e1)(nth e1 lst_orig) )) lst_ord)); criar a lista final usando as posições ordenadas
)

Comentar!Ver os 0 comentários
Operação:Criar Tag:Bloco Circulo
E criar um novo bloco no desenho:

(...)
(setq *Desenho* (vla-get-ActiveDocument (vlax-get-Acad-Object)));identificar o desenho
(setq blocol (vla-get-blocks *desenho*)) ;lista de blocos no desenho
(...)
(setq new_block (vla-add blocol var_pt "caixa_pente") ); cria um novo bloco de nome caixa pente
(vla-addcircle new_block var_pt 0.5);adicionar um circulo ao block
Comentar!Ver os 0 comentários


Operação:Criar Sub-rotinas Tag:Circulo
Criar um Circulo:

(vl-load-com) ; necessário para se usar activex
(setq *ModelSpace* (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object)))); tirar a identificação do model activo
...
(setq pt_temp (list 0 0 0)) ;definir o ponto de inserção
(setq var_pt (bs:lst_array pt_temp )); converter a lista numa variante
(setq circle (vla-addcircle *ModelSpace* var_pt 1)); cria um circulo com 1m de raio no ponto 0,0,0
...
;######## BASES #######
(defun bs:lst_array (ptsList / arraySpace sArray);-> (x y x y .....) => variante
(setq arraySpace (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptsList) 1)) ))
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray) )

Comentar!Ver os 0 comentários
Operação:Propriedades Layer Alterar Cor Criar Tag:
Manipular LAYERS:
...
(setq *Desenho* (vla-get-ActiveDocument (vlax-get-Acad-Object)));identificar o desenho
(setq laycol (vla-get-layers *desenho*)) ;lista de layers no desenho
...
(if (not (tblsearch "layer" "ic_dre_aux")) ; testar se já existe
(progn (setq layobj (vla-add laycol "novo_layer")) ;criar o layer
(vla-put-color layobj 250) ;atribuir uma cor
)) ;_ end of if

(setq lay_orig (vla-get-activelayer *desenho*)) ;tira o layer actual
(vla-put-activelayer *desenho* (vla-item laycol "novo_layer")) ;colocar o novo
(...)
(vla-put-activelayer *desenho* lay_orig); Devolver o original
Comentar!Ver os 0 comentários


Operação:Layer Criar Alterar Tag:Texto
Criar um texto:
...
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
...
(setq pt0 (list 10 10 10))
(setq var_pt (bs:lst_array PT0))
(setq texto (vla-addtext *ModelSpace* "o meu texto" var_pt 2.5))
(vla-put-Alignment texto 13)
(vla-put-TextAlignmentPoint texto var_pt)
(vla-put-layer texto "new_layer")
(vlax-put-property texto "Rotation" pi)
...
;######## BASES ########
(defun bs:lst_array (ptsList / arraySpace sArray);-> (x y x y .....) => Variante
(setq arraySpace (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptsList) 1)) )) (
setq sArray (vlax-safearray-fill arraySpace ptsList)) (vlax-make-variant sArray) )

Comentar!Ver os 0 comentários
Operação:Criar acHatchPatternTypePr Tag:Hatch
Criar um Hatch:

(...)
(setq Hatch (vla-AddHatch *ModelSpace* acHatchPatternTypePreDefined "solid" :vlax-True))
(vlax-invoke hatch 'AppendOuterLoop (list pline))
(vla-evaluate hatch)
(vla-delete pline)
(...)


tão simples né?
Comentar!Ver os 1 comentários


Operação:Sub-rotinas Criar Listas Tag:Polilinha
Criar uma polilinha:
...
(vl-load-com)
(setq *ModelSpace* (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
...
(setq px1 (list 0 0 0))
(setq px2 (list 1 1 0))
(setq var_pt (bs:lst_array (bs:lst_Pt3d->lst_2d (list px1 px2))))
(setq pline (vla-addLightweightPolyline *ModelSpace* var_pt))
...
...

;######## BASES ########
(defun bs:lst_array (ptsList / arraySpace sArray);-> (x y x y .....) => Variante
(setq arraySpace (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptsList) 1)) ))
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray) )

(defun bs:lst_Pt3d->lst_2d (lst_pt3d);-> ((xyz) (xyz)...) =>(x y x y..)
(setq polypoints (apply 'append (mapcar 'bs:Pt3d->Pt2d lst_pt3d))))

Comentar!Ver os 0 comentários
Operação:Propriedades Seleces Tag:
Algumas coisas básicas...

(vl-load-com) ;Imprescindível para se usar Activex

(setq meu_obj (vlax-ename->vla-object (ssname sel_all index))) ;Tirar a identificação de um objecto de uma selecção...

(vlax-dump-object meu_obj) ;Devolve toda a informação do objecto "meu_obj", importante para sabermos que propriedades podemos manipular!
Comentar!Ver os 0 comentários



... AutolisPro é um projecto ainda em construção, tentaremos ser o mais breves possível a implementar as funcionalidades em falta!...


Nesta fase inicial, estamos a angariar novos programadores, se estiver interessado em apostar no nosso projecto entre em contacto connosco!


Pretendemos que o site seja o mais prático e funcional possível. As suas ideias e opiniões são muito importantes para nós, por favor partilhe-as connosco!


Caso detecte algum problema contactar... webmaster Time to buil: 0 ... site online desde Outubro 2008... ... última actualização a 09/12/2014...