Essa é em outro ponto
NA32
Olha aí o menino levantando as cotas d'água em Indiavaí, no Mato Grosso
pense num lugar longe... adicione 500km... é lá!! veja: http://maps.google.com/?ie=UTF8&t=h&om=0&z=16&ll=-15.343872,-58.665254&spn=0.009664,0.014462
pense num lugar longe... adicione 500km... é lá!! veja: http://maps.google.com/?ie=UTF8&t=h&om=0&z=16&ll=-15.343872,-58.665254&spn=0.009664,0.014462
Mais polilinhas
Bom, pra apagar já postei, agora pra INCLUIR vértices, a idéia é: clica o segmento e escolhe a posição do novo vértice... mais...
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, get-points-polig, get-length-of, remove-n, tbn:error-restore
me pergunte por que tem de clicar nesse link...
(defun c:avert (/ tmp ent pts pts2 pt dist lst pr tp b sw ew n)
(tbn:error-init '(("cmdecho" 0) t))
(while (progn
(if (> (length lst) 0)
(initget "U" 0))
(setq tmp
(entsel
(strcat "\nSelecione o segmento a adicionar o vertice"
(if (> (length lst) 0) " [Undo]" ""))))
(or tmp (/= 52 (getvar "errno"))))
(if (= "U" tmp)
(progn
(setq tmp (car lst)
lst (cdr lst))
(entmod tmp)
(entupd (dxf -1 tmp)))
(if tmp
(if (wcmatch (dxf 0 (car tmp)) "*POLYLINE")
(progn
(setq ent (car tmp)
vla (vlax-ename->vla-object ent)
pts (get-points-polig ent)
pr (vlax-curve-getclosestpointtoprojection
ent (trans (cadr tmp) 1 0) '(0 0 1))
dist (vlax-curve-getdistatpoint ent pr)
pts2 nil
n 0
b nil)
(sssetfirst nil (ssadd ent (ssadd)))
(while (if pts
(setq tmp (vlax-curve-getdistatpoint ent (car pts))
tmp (< (if (and (zerop tmp)
(= 1 (length pts)))
(get-length-of ent)
tmp)
dist)))
(setq pts2 (append pts2 (list (car pts)))
pts (cdr pts))
(if (= "LWPOLYLINE" (dxf 0 ent))
(progn
(vla-GetWidth vla n 'sw 'ew)
(setq b (append b (list (list (vla-getbulge vla n)
sw ew)))
n (1+ n)))))
(if (setq pr (getpoint "\nOnde colocar o vertice" pr))
(progn
(setq pr (trans pt 1 0)
pts2 (append pts2 (list pr) pts)
lst (cons (entget ent) lst)
pts2 (if (= "LWPOLYLINE" (dxf 0 ent))
(mapcar '(lambda (x) (remove-n 2 x)) pts2)
pts2)
pts2 (apply 'append pts2)
b (append b '((0.0 0.0 0.0))))
(if (= "LWPOLYLINE" (dxf 0 ent))
(repeat (length pts)
(vla-GetWidth vla n 'sw 'ew)
(setq b (append b
(list (list (vla-getbulge vla n) sw ew)))
n (1+ n))))
(vla-put-coordinates vla
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbdouble
(cons 0 (1- (length pts2))))
pts2))
(setq n 0)
(if (= "LWPOLYLINE" (dxf 0 ent))
(foreach x b
(vla-setbulge vla n (car x))
(vla-setwidth vla n (cadr x) (caddr x))
(setq n (1+ n)))))))))))
(sssetfirst nil nil)
(tbn:error-restore))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, get-points-polig, get-length-of, remove-n, tbn:error-restore
me pergunte por que tem de clicar nesse link...
Get-Length-Of
Esqueci de postar esta rotina:
Link(s) da(s) subrotina(s) usada(s):
get-length-of, ename-of
; função para calcular o comprimento de linhas
(defun get-length-of (ent)
(if (setq ent (ename-of ent))
(vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))))
Link(s) da(s) subrotina(s) usada(s):
get-length-of, ename-of
Mais polilinhas
Como eu disse, mais polilinhas!! Na edição de LWPOLYLINEs, principalmente daquelas que representam poligonais, muitas vezes precisamos excluir alguns vértices, por um motivo qualquer e muitas pessoas simplesmente sobrepõe um vértice a outro... tá funciona, mas não é lá uma solução muito elegante, não concordam?? a rotina a seguir faz isso: apaga vértices da polilinha, apenas clicando-a próximo ao vertice a ser removido quero ver!!
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, get-points-polig, remove-n, tbn:error-restore
depois posto uma que INCLUI vértices, é bem bacana!!
(defun c:dvert (/ tmp d pts d2 pt n lst pr b ent vla sw ew pts2)
(tbn:error-init '(("cmdecho" 0 "osmode" 0) t))
(while (progn
(if (> (length lst) 0)
(initget "U" 0))
(setq tmp
(entsel
(strcat
"\nSelecione a polilinha a eliminar o vertice (proximo ao vertice a ser eliminado)"
(if (> (length lst) 0) " [Undo]" ""))))
(or tmp (/= 52 (getvar "errno"))))
(if (= "U" tmp)
(progn
(setq tmp (car lst)
lst (cdr lst))
(entmod tmp)
(entupd (dxf -1 tmp)))
(if (if tmp (wcmatch (dxf 0 (car tmp)) "*POLYLINE"))
(progn
(setq ent (car tmp)
pts (get-points-polig ent))
(if (> (length pts) 2)
(progn
(setq pr (trans (cadr tmp) 1 0)
n 0
b nil
vla (vlax-ename->vla-object ent)
d 1e30
lst (cons (entget ent) lst))
(sssetfirst nil (ssadd ent (ssadd)))
(if (= "LWPOLYLINE" (dxf 0 ent))
(repeat (length pts)
(vla-GetWidth vla n 'sw 'ew)
(setq b (cons (list (vla-getbulge vla n) sw ew) b)
n (1+ n))))
(setq n 0)
(foreach x pts
(if (< (setq d2 (distance pr x)) d)
(setq d d2
pt n))
(setq n (1+ n)))
(setq pts2
(apply 'append
(if (= "LWPOLYLINE" (dxf 0 ent))
(mapcar '(lambda (x) (remove-n 2 x))
(remove-n pt pts))
(remove-n pt pts))))
(vla-put-coordinates
(vlax-ename->vla-object (car tmp))
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbdouble
(cons 0 (1- (length pts2))))
pts2))
(setq n 0)
(if (= "LWPOLYLINE" (dxf 0 ent))
(foreach x (remove-n pt (reverse b))
(vla-setbulge vla n (car x))
(vla-setwidth vla n (cadr x) (caddr x))
(setq n (1+ n)))))
(prompt "\nNão é possível deixar apenas um vértice"))))))
(sssetfirst nil nil)
(tbn:error-restore t))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, get-points-polig, remove-n, tbn:error-restore
depois posto uma que INCLUI vértices, é bem bacana!!
Manipulação de polilinhas
Hoje vou postar uma rotina que me ajuda muito no trabalho de desenhar o levantamento de campo, principalmente quando estou desenhando ruas... Com ela é possível transformar segmentos de polilinhas (LWPOLYLINE) em arcos, diretamente, sem trims, arcs ou joins.. para usar, basta ter a polilinha (obviamente) e usar o comando ABUL (que é definido na rotina), em seguida ir clicando os segmentos que serão convertidos em arcos
Antes que alguem pergunte porque esse nome "ABUL": A de ADD (adicionar) e BUL de BULGE (bulge=2h/D, onde D é o comprimento da corda que une os extremos do arco e h é a distância entre o ponto médio destes pontos e o ponto medio do ARCO)mais...
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, get-points-polig, media, get-length-of, tbn:error-restore
(defun c:abul (/ tmp ent pt pts p bul pm p1 p2 p3 os arc h lst)
(tbn:error-init '(("cmdecho" 0 "osmode" 0) t))
(while (progn
(if (> (length lst) 0) (initget "U" 0))
(setq tmp
(entsel
(strcat
"\nSelecione a polilinha no trecho a adicionar o arco"
(if (> (length lst) 0) " [Undo]" ""))))
(or tmp (/= 52 (getvar "errno"))))
(if (= "U" tmp)
(progn
(setq tmp (car lst)
lst (cdr lst))
(vla-setbulge
(vlax-ename->vla-object (car tmp))
(cadr tmp)
(caddr tmp)))
(if (= "LWPOLYLINE" (dxf 0 (car tmp)))
(progn
(setq pt (trans (cadr tmp) 1 0)
ent (car tmp)
pt (vlax-curve-getclosestpointtoprojection ent pt '(0 0 1))
p (list (vlax-curve-getdistatpoint ent pt) pt)
pts (get-points-polig ent)
p (1- (vl-position p
(vl-sort
(cons
p
(mapcar
'(lambda (p)
(list
(vlax-curve-getdistatpoint
ent
p)
p))
pts))
'(lambda (e1 e2) (< (car e1) (car e2))))))
p1 (nth p pts)
p2 (nth (1+ p) pts)
p2 (if p2 p2 (car pts))
pm (media p1 p2)
p3 (getpoint (trans pm 0 1)
"\nEntre com a posição do 3º ponto")
os (getvar "osmode"))
(if p3
(progn
(setvar "osmode" 0)
(command "arc" (trans p1 0 1) p3 (trans p2 0 1))
(setvar "osmode" os)
(sssetfirst nil (ssadd ent (ssadd)))
(setq arc (entlast)
p3 (vlax-curve-getpointatdist arc (/ (get-length-of arc) 2))
h (distance p3 pm)
bul (/ (* 2 h) (distance p1 p2)))
(if (equal 0.0
(distance p3 (polar pm (+ (angle p1 p2) (/ pi 2)) h))
0.0001)
(setq bul (- bul)))
(setq lst
(cons (list ent p (vla-getbulge (vlax-ename->vla-object ent) p))
lst))
(vla-setbulge (vlax-ename->vla-object ent) p bul)
(entdel arc))))
(prompt "\nNão é POLILINHA"))))
(sssetfirst nil nil)
(tbn:error-restore))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, get-points-polig, media, get-length-of, tbn:error-restore
logo postarei uma que elimina estes arcosm uma que adiciona e uma que elimina vértices... aguardem
Como Criar DimStyle com Visual Lisp
presta bem atenção, pois é meio complicado:
via entmake eu nao cheguei a ver, mas não deve ser impossível...
já via activex ( VL, visual lisp ) é como eu apresentei acima
vc cria a dimstyle com o metodo ADD do activex, mas como este não ofereçe a possibilidade de configurar a dimstyle diretamente, temos de configurar as SYSTEM VARIABLES DO DOCUMENTO e sobreescreve-las na nossa dimstyle, com o método COPYFROM
pode parecer complexo, mas veja que o codigo é bastante reduzido, permitindo facil compreensão
(setq
;pega o activedocument:
thisdrawing (vla-get-activedocument (vlax-get-acad-object))
;pega a collection de dimensions deste documento:
dimstyles (vla-get-dimstyles thisdrawing)
;verifica a existencia da dimstyle e pega/ou cria ela:
dimsty (if (not (tblsearch "dimstyle" "sua_dimension"))
(vla-add dimstyles "sua_dimension")
(vla-item dimstyles "sua_dimension")))
;|
Para configurar a sua dimension style via visual lisp,
você deve configurar todas as variaveis de dimensoes que desejar
Para isso, "DIMSTYLE group codes" no help do visual lisp do cad
exemplo, vou configurar a dimscale e dimgap:|;
(setvar "dimscale" 0.1)
(setvar "dimgap" 0.5)
;feita as configurações, copie elas para a SUA dimstyle:
(vla-copyFrom dimsty thisdrawing)
;|é assim que faz, pois o objeto DIMSTYLE não oferece diretamente
as propriedades dimscale, dimgap, etc...
faça um teste:
(vlax-dump-object dimsty t)
veja que não aparecem estas e as outras propriedades...|;
via entmake eu nao cheguei a ver, mas não deve ser impossível...
já via activex ( VL, visual lisp ) é como eu apresentei acima
vc cria a dimstyle com o metodo ADD do activex, mas como este não ofereçe a possibilidade de configurar a dimstyle diretamente, temos de configurar as SYSTEM VARIABLES DO DOCUMENTO e sobreescreve-las na nossa dimstyle, com o método COPYFROM
pode parecer complexo, mas veja que o codigo é bastante reduzido, permitindo facil compreensão
Uma rotina diferente hoje... ela desenha um par de linhas, mais ou menos no estilo das MLINE, com uma diferença: é possível alterar o ponto base da linha enquanto se desenha uma linha, algo como, começa pelo ponto a esquerda da linha e termina pelo lado direito, melhor vocês rodarem ela pra ver o que acontece... então deixa eu ver!
(defun c:ml2 (/ tmp ip fp lst lp of)
(tbn:error-init (list (list "cmdecho" 0) t))
(setq ip "D"
fp "D"
lst nil
lp nil
of 0.15
lay (getvar "clayer"))
(while (progn (initget (strcat "O D E C U S I" (if (> (length lst) 1) " F" "")) 0)
(setq str (strcat "\noffset: " (rtos of 2) " Inicio:\"" ip
"\" Fim:\"" fp
"\"\nEntre com um ponto ou [Offset, Direita, Centro, Esquerda, Início"
(if (> (length lst) 1) ", Fechar" "")
", Sair, Undo] <Sair>")
tmp (if lp
(getpoint (trans lp 0 1) str)
(getpoint str)))
(if (= tmp "F")
(progn
(setq fp (caddar lst))
(ml2_processaponto (dxf 10 (cadar lst)) lay)
(ml2_chanfra
(caar lst)
(cadar lst)
(car (last lst))
(cadr (last lst)))
(setq tmp "S")))
(/= "S" (if tmp tmp "S")))
(cond ((= "O" tmp)
(if (setq tmp
(getdist
(strcat "\nEntre com o offset <" (rtos of 2) ">")))
(setq of tmp)))
((= "I" tmp)
(initget "D E C" 0)
(if (setq tmp
(getkword
(strcat
"\nIniciar com [Direita, Centro, Esquerda] <"
ip
">")))
(setq ip tmp)))
((member tmp '("D" "C" "E")) (setq fp tmp))
((= "U" tmp)
(setq tmp (last lst)
lst (vl-remove tmp lst))
(del-ent (car tmp))
(del-ent (cadr tmp))
(setq ip (caddr tmp)
fp (cadddr tmp)
lp (nth 4 tmp)))
((= "F" tmp)
(setq fecha t))
((listp tmp) (ml2_processaponto (trans tmp 1 0) lay))))
(tbn:error-restore))
(defun ml2_processaponto
(tmp lay / str ang an2 dist p1 p2 p3 p4 e1 e2)
(if (not lp)
(setq lp tmp)
(progn
(setq ang (angle lp tmp)
dist (distance lp tmp))
(cond ((= ip fp "C") ;ok2
(setq an2 (+ ang (/ pi 2))
p3 (polar lp an2 (/ of 2))
p4 (polar tmp an2 (/ of 2))
p1 (polar lp an2 (/ of -2))
p2 (polar tmp an2 (/ of -2))))
((= ip fp "E") ;ok2
(setq an2 (+ ang (/ pi 2))
p1 lp
p2 tmp
p3 (polar lp an2 of)
p4 (polar tmp an2 of)))
((= ip fp "D") ;ok2
(setq an2 (- ang (/ pi 2))
p1 (polar lp an2 of)
p2 (polar tmp an2 of)
p3 lp
p4 tmp))
((= ip "D")
(if (= fp "E")
(setq an2 (- ang (acos (/ of (distance lp tmp)))) ;ok2
p1 (polar lp an2 of)
p2 tmp
p3 lp
p4 (polar tmp an2 (- of)))
(setq an2 (- ang (acos (/ of (* 2 (distance lp tmp)))))
;ok2
p3 lp
p4 (polar tmp an2 (/ of -2))
p1 (polar lp an2 of)
p2 (polar tmp an2 (/ of 2)))))
((= ip "E")
(if (= fp "D") ;ok2
(setq an2 (+ ang (acos (/ of (distance lp tmp))))
p1 (polar lp an2 of)
p2 tmp
p3 lp
p4 (polar tmp an2 (- of)))
(setq an2 (+ ang (acos (/ of (* 2 (distance lp tmp)))))
;ok2
p1 (polar lp an2 of)
p2 (polar tmp an2 (/ of 2))
p3 lp
p4 (polar tmp an2 (/ of -2)))))
((= ip "C")
(if (= fp "D")
(setq an2 (+ ang (acos (/ of (* 2 (distance lp tmp)))))
p3 (polar lp an2 (/ of 2))
p4 tmp
p1 (polar lp an2 (/ of -2))
p2 (polar tmp an2 (- of)))
(setq an2 (+ ang (acos (/ of (* 2 (distance lp tmp)))))
p3 (polar lp an2 (/ of 2))
p4 (polar tmp an2 of)
p1 (polar lp an2 (/ of -2))
p2 tmp))))
(setq e1 (draw-line (remove-n 2 p1) (remove-n 2 p2) lay)
e2 (draw-line (remove-n 2 p3) (remove-n 2 p4) lay)
ip fp
lst (append lst (list (list e1 e2 ip fp lp)))
lp tmp)
(if (> (length lst) 1)
(progn
(setq tmp (nth (- (length lst) 2) lst))
(ml2_chanfra e1 e2 (car tmp) (cadr tmp))
)))))
(defun ml2_chanfra (e1 e2 a1 a2 / p1 p2 tmp a b)
(setq p1 (inters (dxf 10 a1) (dxf 11 a1) (dxf 10 e1) (dxf 11 e1) nil)
p2 (inters (dxf 10 a2) (dxf 11 a2) (dxf 10 e2) (dxf 11 e2) nil)
a (draw-pline2 (list (dxf 10 a1) p1 (dxf 11 e1)) "0" nil)
b (draw-pline2 (list (dxf 10 a2) p2 (dxf 11 e2)) "0" nil))
(if (> (length (get-intersectpoints a b)) 0)
(setq tmp e1
e1 e2
e2 tmp
p1 (inters (dxf 10 a1) (dxf 11 a1) (dxf 10 e1) (dxf 11 e1) nil)
p2 (inters (dxf 10 a2) (dxf 11 a2) (dxf 10 e2) (dxf 11 e2) nil)))
(del-ent a)
(del-ent b)
(remake-ent a1 11 p1)
(remake-ent a2 11 p2)
(remake-ent e1 10 p1)
(remake-ent e2 10 p2))
OCS e WCS
Ontem, estava "soldando" umas linhas com a minha rotina MJ4 quando derepente ela me falha!! putz, fiquei cabreiro, afinal havia testando ela de todas as formas que eu pude imaginar!!! Curioso, foi tentar descobrir o que estava acontecendo...
mais...
Pra minha surpresa, tudo parecia estar em ordem, mas simplesmente não funcionava, não emendava as polilinhas.. pensei: deve ter erro no programa... mais ou menos...
Fiz o de praxe teste o programa passo a passo e estava tudo certo, até que cheguei numa linha onde é requerida a coordenada do início da linha... e tava lá: retornava uma coordenada que não tinha nada a ver com a coordenada que era esperada!!!
Corri ver a ELIST da polilinha (era uma lwpolyline) e estranho, os dxf 10 eram diferentes mesmo... e no final da ELIST tinha o mais que ignorado dxf 210 percebi que eram valores diferentes do usual: (210 0.0 0.0 1.0) e estava ali o problema!!! quando selecionei a entidade e tentei um stretch o UCS mudou totalmente, então fui ver o que o help me dizia: ele dizia que o dxf 10 das LWPOLYLINE são dados em OCS (object coordinate system)
então: eu estava comparando coordenadas de sistemas diferentes, WCS e OCS
para transformar de OCS para WCS é simples, basta usar a função trans:
(trans pt ent 0)
Onde PT é a coordenada, ENT é a ENAME da entidade (isso mesmo, ename) e 0 significa que estou convertendo para WCS
mas importante: no caso de LWPOLYLINE, o dxf 10 é 2d!! é preciso incluir o Z na coordenada, que é o DXF 38 (elevation)
Vejam um exemplo:
isso TEM que retornar T (true)
Bom, agora o MJ4 está totalmente funcional (espero...) a rotina que foi atualizada é o get-points-polig
Obs:
Quem estiver usando alguma das minhas rotinas que dela dependam, é só substituir esta última
mais uma coisa: façam o teste: desenhe uma LINE por 0,0,0 e 10,10,10, agora use o comando PEDIT nesta line, responda Yes quando ele perguntar sé é pra converter em PLINE. Em seguida obtenham o ELIST da pline criada... vejam que os dxf 10 não são 0,0,0 10,10,10 e o dxf 210 é diferente do 0,0,1 normal
Fiz o de praxe teste o programa passo a passo e estava tudo certo, até que cheguei numa linha onde é requerida a coordenada do início da linha... e tava lá: retornava uma coordenada que não tinha nada a ver com a coordenada que era esperada!!!
Corri ver a ELIST da polilinha (era uma lwpolyline) e estranho, os dxf 10 eram diferentes mesmo... e no final da ELIST tinha o mais que ignorado dxf 210 percebi que eram valores diferentes do usual: (210 0.0 0.0 1.0) e estava ali o problema!!! quando selecionei a entidade e tentei um stretch o UCS mudou totalmente, então fui ver o que o help me dizia: ele dizia que o dxf 10 das LWPOLYLINE são dados em OCS (object coordinate system)
então: eu estava comparando coordenadas de sistemas diferentes, WCS e OCS
para transformar de OCS para WCS é simples, basta usar a função trans:
(trans pt ent 0)
Onde PT é a coordenada, ENT é a ENAME da entidade (isso mesmo, ename) e 0 significa que estou convertendo para WCS
mas importante: no caso de LWPOLYLINE, o dxf 10 é 2d!! é preciso incluir o Z na coordenada, que é o DXF 38 (elevation)
Vejam um exemplo:
(setq ss (ssget ":S" '((0 . "LWPOLYLINE"))) ;selecione a pline
ent (ssname ss 0);pega a ename da pline
elev (dxf 38 ent);elevação
pt (dxf 10 ent));primeiro vertice em OCS
(equal ;os pontos obtidos abaixo são iguais?
(trans (append pt (list elev)) ent 0) ;coverte OCS pra WCS
(vlax-curve-getstartpoint ent))
isso TEM que retornar T (true)
Bom, agora o MJ4 está totalmente funcional (espero...) a rotina que foi atualizada é o get-points-polig
Obs:
Quem estiver usando alguma das minhas rotinas que dela dependam, é só substituir esta última
mais uma coisa: façam o teste: desenhe uma LINE por 0,0,0 e 10,10,10, agora use o comando PEDIT nesta line, responda Yes quando ele perguntar sé é pra converter em PLINE. Em seguida obtenham o ELIST da pline criada... vejam que os dxf 10 não são 0,0,0 10,10,10 e o dxf 210 é diferente do 0,0,1 normal
Limpar Groups Vazios
Você usa o GROUP? se usa o Posicao (da manfra), com ceteza, mesmo que não saiba... bom acontece que ao apagar as entidades de um GROUP, este não é apagado, fica lá... se você usar o comando GROUP, verá que o GROUP continua lá, aé você pode "explodir" o group, pelo editor de groups do cad (que convenhamos, é muito tosco..), mas e se você tiver milhares deles? pior ainda, pois fica difícil achar um group qualquer... então fiz este programinha
mostra aí!!
;limpa grupos vazios
(defun c:limpagrupos(/ x n)
(tbn:error-init (list (list "cmdecho" 0) t))
(Setq n 0)
(vlax-for x (vla-get-Groups thisdrawing)
(if (= 0 (vla-get-count x)) (progn (setq n (1+ n)) (vla-delete x))))
(prompt (strcat "\n" (itoa n) " grupo(s) vazio(s) apagado(s)"))
(tbn:error-restore))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, thisdrawing, tbn:error-restore
(defun c:limpagrupos(/ x n)
(tbn:error-init (list (list "cmdecho" 0) t))
(Setq n 0)
(vlax-for x (vla-get-Groups thisdrawing)
(if (= 0 (vla-get-count x)) (progn (setq n (1+ n)) (vla-delete x))))
(prompt (strcat "\n" (itoa n) " grupo(s) vazio(s) apagado(s)"))
(tbn:error-restore))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, thisdrawing, tbn:error-restore
Dimensions de cabeça pra baixo
Atendendo a pedidos, aí vai a rotina para desvirar dimensions que estejam de cabeça pra baixo
Não está totalmente testada, mas já está funcionando... pelo menos aqui... se o seu UCS estiver rotacionado e a rotina não estiver produzindo efeito, experimente digitar PLAN na linha de comando, escolher CURRENT, e usar a rotina novamente
Não está totalmente testada, mas já está funcionando... pelo menos aqui... se o seu UCS estiver rotacionado e a rotina não estiver produzindo efeito, experimente digitar PLAN na linha de comando, escolher CURRENT, e usar a rotina novamente
mais...
(defun c:rotdim (/ ss ent xdir)
(tbn:error-init (list (list "cmdecho" 0) T))
(setq ss (ssget '((0 . "DIMENSION")))
xdir (angle (trans '(0 0) 0 1) (trans '(1 0) 0 1)))
(repeat (if ss (sslength ss) 0)
(setq ent (ssname ss 0))
(remake-ent ent 51 xdir)
(ssdel ent ss))
(tbn:error-restore t))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, remake-ent, tbn:error-restore
(tbn:error-init (list (list "cmdecho" 0) T))
(setq ss (ssget '((0 . "DIMENSION")))
xdir (angle (trans '(0 0) 0 1) (trans '(1 0) 0 1)))
(repeat (if ss (sslength ss) 0)
(setq ent (ssname ss 0))
(remake-ent ent 51 xdir)
(ssdel ent ss))
(tbn:error-restore t))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, remake-ent, tbn:error-restore
Desvirar textos de cabeça para baixo
Uma rotininha que já existe no civil 3d para as "labels" que eu imitei para funcionar com textos... É assim: você desenha os textos e tal, mas no layout, devido ao formato do desenho, rotaciona a viewport e os textos ficam de cabeça pra baixo (ou de ponta-cabeça, dependendo de onde tu mora, tchê!!!)... na mão ia demorar um bocado, mas assim é covardia:
Deixa eu ver!!!
(defun c:rottxt (/ ss rot ent)
;controle de erros:
(tbn:error-init (list (list "cmdecho" 0) t))
;seleciona textos:
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(repeat (if ss (sslength ss) 0)
(setq ent (ssname ss 0)
rot (dxf 50 ent);rotação em radianos
rot (if (= "MTEXT" (dxf 0 ent));rotação em UCS
(angle (trans '(0 0) 1 0)
(trans (polar '(0 0) rot 1) 1 0))
rot));text tem rotação em WCS
;| se a rotação encontrada é
diferenta daquela que o texto tem:|;
(if (/= rot (rot-of-ucs rot))
(progn
;assim é mais facil obter o ponto do centro do texto:
(setq box (textbox2 ent))
;rotaciona em 180º:
(vla-rotate
(vlax-ename->vla-object ent)
(vlax-3d-point (media (car box) (caddr box)))
pi)))
;contador na barra inferior:
(grtext -2 (itoa (sslength ss)))
(ssdel ent ss))
;restaura sem erros:
(tbn:error-restore t))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, rot-of-ucs, textbox2, media, tbn:error-restore
;controle de erros:
(tbn:error-init (list (list "cmdecho" 0) t))
;seleciona textos:
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(repeat (if ss (sslength ss) 0)
(setq ent (ssname ss 0)
rot (dxf 50 ent);rotação em radianos
rot (if (= "MTEXT" (dxf 0 ent));rotação em UCS
(angle (trans '(0 0) 1 0)
(trans (polar '(0 0) rot 1) 1 0))
rot));text tem rotação em WCS
;| se a rotação encontrada é
diferenta daquela que o texto tem:|;
(if (/= rot (rot-of-ucs rot))
(progn
;assim é mais facil obter o ponto do centro do texto:
(setq box (textbox2 ent))
;rotaciona em 180º:
(vla-rotate
(vlax-ename->vla-object ent)
(vlax-3d-point (media (car box) (caddr box)))
pi)))
;contador na barra inferior:
(grtext -2 (itoa (sslength ss)))
(ssdel ent ss))
;restaura sem erros:
(tbn:error-restore t))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, rot-of-ucs, textbox2, media, tbn:error-restore
Atenção, ela não muda a rotação para 0, mas sim vê se o texto ficou de cabeça pra baixo, se ficar, rotaciona em 180 graus!!
Assinar:
Postagens (Atom)