Mj4

4 comentários em “Mj4”

1. 

   Alex Librelon

   10 de novembro de 2006 em 08:00

   Este comentário foi removido por um administrador do blog.

   Acesse para responder
2. 

   Anônimo

   8 de novembro de 2006 em 12:50

   é por ai mesmo… os links vc abre e vai colando no final (uo no inicio, eu prefiro no inicio) da rotina

   experimente carregar essa montagem que vc fez… se não der erro, ta blz…

   Acesse para responder
3. 

   Alex Librelon

   8 de novembro de 2006 em 12:46

   Neyton, bom dia!

   Primeiramente, me desculpe por te chamar de NeIton no post anterior e segundamente, eu sou lerdo demais!!

   Por favor, veja se o que estou fazendo está mais ou menos correto,
   Veja a montagem da sua rotina como ficou e me diga o que estou fazendo de errado.
   Eu fiz o seguinte, onde tem link para uma rotina externa, eu colei esta rotina no final da rotina mãe, veja:

   (defun c:mj4 (/ ss ent lpt dd mj4_procpt new zc s flag lay n)
   (tbn:error-init (list (list “cmdecho” 0 “osmode” 0)
   ‘(command “._zoom” “c” zc s)))
   ;seleciona as linhas:
   (setq ss (ssget ‘((0 . “LINE,POLYLINE,LWPOLYLINE”)))
   ;pede as distancia mínimas entre pontos
   ;que poderão ser conciderados iguais:
   mj4:dd (if mj4:dd mj4:dd 0.001) ;lembre da próxima vez
   dd (getdist (strcat
   “nQual a distância será permitida? <"
   (rtos mj4:dd 2)
   “>”))
   dd (if dd dd mj4:dd)
   mj4:dd dd ;lembre na próxima utilização o valor
   ;função que calculará a lista de pontos da nova 3dpoly
   mj4_procpt (lambda (pt start / s2 e2 lst)
   ;procura as ents que podem servir:
   (setq s2 (ssget “CP” (get-lpt 20 dd (trans pt 0 1))
   ‘((0 . “LINE,POLYLINE,LWPOLYLINE”))))
   ;calcula as distâncias entre PT e o inicio e o fim de cada uma delas:
   (repeat (if s2 (sslength s2) 0)
   (setq e2 (ssname s2 0)
   ;só processa se fizer parte da seleção inicial:
   ;lst estará nesta forma: (distancia entidade inicio/fim)
   lst (if (ssmemb e2 ss)
   (append lst
   (list
   (list
   (distance pt
   (vlax-curve-getstartpoint e2))
   e2 t)
   (list
   (distance pt
   (vlax-curve-getendpoint e2))
   e2 nil)))
   lst))
   (ssdel e2 s2))
   ;escolhe a que estiver mais perto
   ;colocando as distâncias em ordem crescente:
   (setq lst (car (vl-sort lst
   ‘(lambda (e1 e2)
   (< (car e1) (car e2))))))
   ;se der certo,
   (if lst
   ;se a distancia for aceitável:
   (if (<= (car lst) dd)
   (progn
   ; pega suas coordenadas e apague ela:
   (setq lpt
   (if start
   (append
   (if (caddr lst)
   (reverse (get-points-polig e2))
   (get-points-polig e2))
   (cdr lpt))
   (append
   lpt
   (cdr (if (caddr lst)
   (get-points-polig e2)
   (reverse
   (get-points-polig e2)))))))
   (ssdel e2 ss)
   (entdel e2)
   t))))
   zc (getvar “viewctr”)
   s (getvar “viewsize”))
   ;zoom extens para o ssget não dar problema:
   (command “._zoom” “e”)
   ;processa a seleção toda:
   (while (> (sslength ss) 0)
   ;pega a entidade da seleção, pega o layer e seus vertices:
   (setq ent (ssname ss 0)
   lpt (get-points-polig ent)
   lay (dxf 8 ent)
   n 0
   flag nil) ;inicializa a variavel flag
   ;apaga a entidade:
   (entdel ent)
   ;enquanto conectar alguma coisa nessa lista:
   (while (or (mj4_procpt (car lpt) t) ;no inicio
   (mj4_procpt (last lpt) nil)) ;ou no fim
   (grtext -2 (strcat (itoa (sslength ss)) “: “
   (itoa (setq n (1+ n)))))
   (setq flag t)) ;conectou pelo menos algo?
   (if flag ;mesmo?
   (progn
   ;desenha uma nova polilinha:
   (setq new (draw-pline2 lpt lay nil))
   (ssadd (handent new) ss))
   ;não deu… “desdeleta” a entidade:
   (entdel ent))
   (grtext -2 (itoa (sslength ss)))
   (ssdel ent ss))
   (command “._zoom” “c” zc s)
   (tbn:error-restore t))
   ;| tbn:error-subst (s):
   substitui a função *error* do cad
   tbn:error-restore (flag) :
   restaura o sistema em caso de erro
   flag: t -> terminou o programa sem erros
   nil -> erro na execução do programa
   tbn:error-init (sys):
   inicia o sistema para pegar erros
   sys: (list_a list_b)
   list_a -> variavieis do sistema com valores
   a serem restaurados
   list_b -> uma rotina a ser executada
   em caso de erro|;
   (defun tbn:error-subst (s /)
   (while (/= 0 (getvar “cmdactive”)) (command “”))

   (if (/= s “Function cancelled”)
   (progn
   (princ (strcat “nError: ” s))
   (command “_.UNDO” “_e”)
   (princ “nundoing “)
   (command “_.U”)
   (tbn:error-restore nil))
   (tbn:error-restore t)))

   (defun tbn:error-restore (flag /)
   (while (/= 0 (getvar “cmdactive”)) (command “”))
   (command “_.REDRAWALL”)
   (if flag
   (command “_.UNDO” “_E”))
   (cond
   ((/= 1 (logand tbn:error_undo 1))
   (command “_.undo” “_control” “_none”))
   ((= 2 (logand tbn:error_undo 2))
   (command “_.undo” “_control” “_one”)))
   (mapcar ‘(lambda (x) (setvar (car x) (cadr x)))
   tbn:error_sys)
   (setq *error* tbn:error_olderr)
   (eval tbn:error_exe)
   (princ))

   (defun tbn:error-init (sys / tmp ss)
   (if m:err
   (setq tbn:error_olderr m:err
   *error* tbn:error-subst)
   (setq tbn:error_olderr *error*
   *error* tbn:error-subst))
   (setq tbn:error_exe
   (cadr sys)
   sys (car sys)
   tbn:error_sys
   nil
   tbn:error_undo
   (getvar “undoctl”)
   ss (ssgetfirst))
   (repeat (/ (length sys) 2)
   (setq tmp (car sys)
   tbn:error_sys (cons (list tmp (getvar tmp))
   tbn:error_sys)
   tmp (setvar tmp (cadr sys))
   sys (cddr sys)))
   (cond
   ((= 2 (logand tbn:error_undo 2))
   (command “_.undo” “_control” “_all”
   “_.undo” “_auto” “_off”))
   ((/= 1 (logand tbn:error_undo 1))
   (command “_.undo” “_all” “_.undo”
   “_auto” “_off”)))
   (command “_.UNDO” “_group”)
   (sssetfirst (car ss) (cadr ss)))
   (defun get-points-polig (ent / x tp tmp)
   (setq ent (ename-of ent)
   tp (dxf 0 ent))
   (cond ((wcmatch tp “LINE,LWPOLYLINE,SPLINE,MLINE”)
   (vl-remove nil
   (mapcar ‘(lambda (x)
   (if (member (car x) ‘(10 11))
   (cdr x)))
   (entget ent))))
   ((= “POLYLINE” tp)
   (while (/= “SEQEND” (dxf 0 (setq ent (entnext ent))))
   (setq tmp (append tmp (list (dxf 10 ent))))))
   ((= “VIEWPORT”)
   (if (dxf 0 (dxf 340 ent))
   (get-points-polig (dxf 340 ent))
   (list (car (setq tmp (get-bounding-box ent)))
   (list (caadr tmp) (cadar tmp))
   (cadr tmp)
   (list (caar tmp) (cadadr tmp)))))))
   (defun dxf (dx ent / tmp ls? l e n)
   (if (= ‘PICKSET (type ent))
   (progn
   (setq n 0)
   (repeat (sslength ent)
   (setq e (ssname ent n)
   n (1+ n)
   l (append l (list (dxf dx e)))))
   l)
   (progn
   (setq ent (if (listp ent)
   ent
   (if (setq tmp (ename-of ent))
   (entget tmp ‘(“*”))))
   ls? (listp dx)
   dx (if ls? dx (list dx))
   tmp (if ent
   (mapcar
   ‘(lambda (x) (cdr (assoc x ent)))
   dx)))
   (if ls? tmp (car tmp)))))
   (defun ename-of (ent)
   (if (setq ent
   (cond
   ((= ‘STR (type ent)) (handent ent))
   ((= ‘VLA-OBJECT (type ent))
   (vlax-vla-object->ename ent))
   ((listp ent) (cdr (assoc -1 ent)))
   (t ent)))
   (if (entget ent) ent)))
   (defun draw-pline2 (pts lay close? / elev)
   (setq elev (caddar pts))
   (dxf 5
   (if (vl-every
   ‘(lambda (x) (equal x elev))
   (mapcar ‘caddr pts))
   (entmakex
   (append
   (mapcar
   ‘cons
   ‘(0 100 8 100 90 70 38)
   (list “LWPOLYLINE” “AcDbEntity”
   lay “AcDbPolyline” (length pts)
   (if close? 1 0) (if elev elev 0)))
   (mapcar
   ‘(lambda (x) (cons 10 x))
   pts)))
   (progn
   (entmake
   (mapcar
   ‘cons ‘(0 100 8 100 70)
   (list “POLYLINE” “AcDbEntity”
   lay “AcDbPolyline”
   (if close? 9 8))))
   (foreach x pts
   (entmake
   (list ‘(0 . “VERTEX”)
   ‘(100 . “AcDbEntity”)
   ‘(100 . “AcDbVertex”)
   ‘(100 . “AcDb3dPolylineVertex”)
   (cons 10 x) ‘(70 . 32))))
   (entmakex ‘((0 . “SEQEND”)
   (100 . “AcDbEntity”)))
   (entlast)))))

   Sei que fiz tudo errado mas, onde está o erro para que eu possa aproveitar as rotinas postadas em seu blog.

   Abraços!!

   ** Desculpe por postar algo tão grande.

   Acesse para responder
4. 

   Anônimo

   7 de novembro de 2006 em 12:48

   nao, nem todos

   os que dão endereços externos ao post sim, exemplo: DXF
   esta é uma subrotina… deve ser sala e carregada a parte

   já mj4_procpt é um link para a propria pagina, percebe que a pagina apenas dá um “salto” ate ela?

   Acesse para responder