Un post super specialista, ma mi son fatto un tal mazzo a creare questa routine in LISP per AutoCAD che voglio pubblicarla, magari in tutto il web a qualcuno può servire.
A che serve? A eliminare ridondanze e mal di pancia per "sporco" presente nella modellazione di qualcosa in 3D.
Non mi addentro nei casini che risolve il FIX, dico solo che AutoCAD ha una gestione elevata del floating point (tradotto, usa un numero grandissimo di decimali). In più AutoCAD crea 3DFACE a 4 lati, mentre tanti modellatori, quasi tutti, le usano a 3 lati.
Capita quindi, prima delle conversioni, che inavvertitamente in AutoCAD si sia creata una faccia a 4 lati, di cui uno minimissimo, per svariati motivi, sembra un triangolo ma non lo è, è un poligono a 4 lati. Ha 4 vertici anche se due di loro sono talmente vicini da parere uno solo.
Cosa capita, coi convertitori? Che questa faccia a 4 vertici diventa due triangoli di cui uno (con meno decimali) un vero fantasma.
Area zero, perché il converter ha separato il poligono a 4 lati in due triangoli, ma il secondo ha due vertici coincidenti (mancando i decimali che li separano).
Da qui, errori, sporco nel disegno, etc etc.
Questa routine in Lisp, caricata in AutoCAD, fruga in una selezione di facce, e se trova toglie questo doppio vertice (o meglio, rende i due vertici coincidenti) se nello spazio lo scostamento tra i due è minore dei 6 decimali, ed è quindi invisibile, o rifiutato, su altri modellatori. Ed evita che vengano create facce fantasma ad area zero.
E magari è "didattica" per chi usi il LISP in 3D
Codice:
(defun fixvertex ()
(prompt "\nFix small vertex distance in 3DFACE: ")
(setq selez(ssget))
(if (/= nil selez)
(progn
(setq max (sslength selez) contasel 0)
(while (> max contasel)
(setq en (ssname selez contasel) alist (entget en))
(if (= "3DFACE" (cdr(assoc 0 alist)))
(progn
(setq ed alist)
; ---------------------------------------------------------------------------------
(setq pntA (cdr(assoc 10 ed)))
(setq pntB (cdr(assoc 11 ed)))
(setq pntA (list (car pntA)(cadr pntA)(caddr pntA)))
(setq pntB (list (car pntB)(cadr pntB)(caddr pntB)))
(if
(AND (< (distance pntA pntB) 0.000001) (> (distance pntA pntB) 0) )
(progn
(setq pntA (list 11 (car pntA)(cadr pntA)(caddr pntA)))
(setq new pntA)
(setq ed (subst pntA (assoc 11 ed) ed))
(entmod ed) (prompt "\n*DONE*")
)
)
; ---------------------------------------------------------------------------------
(setq pntB (cdr(assoc 11 ed)))
(setq pntC (cdr(assoc 12 ed)))
(setq pntB (list (car pntB)(cadr pntB)(caddr pntB)))
(setq pntC (list (car pntC)(cadr pntC)(caddr pntC)))
(if
(AND (< (distance pntB pntC) 0.000001) (> (distance pntB pntC) 0) )
(progn
(setq pntB (list 12 (car pntB)(cadr pntB)(caddr pntB)))
(setq new pntB)
(setq ed (subst pntB (assoc 12 ed) ed))
(entmod ed) (prompt "\n*DONE*")
)
)
; ---------------------------------------------------------------------------------
(setq pntC (cdr(assoc 12 ed)))
(setq pntD (cdr(assoc 13 ed)))
(setq pntC (list (car pntC)(cadr pntC)(caddr pntC)))
(setq pntD (list (car pntD)(cadr pntD)(caddr pntD)))
(if
(AND (< (distance pntC pntD) 0.000001) (> (distance pntC pntD) 0) )
(progn
(setq pntC (list 13 (car pntC)(cadr pntC)(caddr pntC)))
(setq new pntC)
(setq ed (subst pntC (assoc 13 ed) ed))
(entmod ed) (prompt "\n*DONE*")
)
)
; ---------------------------------------------------------------------------------
(setq pntD (cdr(assoc 13 ed)))
(setq pntA (cdr(assoc 10 ed)))
(setq pntD (list (car pntD)(cadr pntD)(caddr pntD)))
(setq pntA (list (car pntA)(cadr pntA)(caddr pntA)))
(if
(AND (< (distance pntD pntA) 0.000001) (> (distance pntD pntA) 0) )
(progn
(setq pntD (list 10 (car pntD)(cadr pntD)(caddr pntD)))
(setq new pntD)
(setq ed (subst pntD (assoc 10 ed) ed))
(entmod ed) (prompt "\n*DONE*")
)
)
; ---------------------------------------------------------------------------------
) ; close progn
) ; close if face
(setq contasel (+ 1 contasel))
) ; close while
) ; close progn
) ; close if no nil
(prompt "\nReady")
) ; close defun
;-------------------------------------------------------------------------------
Login
Iscriviti
FAQ
Cerca
