ASN
https://www.amiciscalan.com:443/forum/

FIX di modellazione CAD
https://www.amiciscalan.com:443/forum/viewtopic.php?f=51&t=7746
Pagina 1 di 1

Autore:  Giovanni Seregni [ 31/03/2017, 13:29 ]
Oggetto del messaggio:  FIX di modellazione CAD

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
;-------------------------------------------------------------------------------

Autore:  Giovanni Seregni [ 03/04/2017, 11:39 ]
Oggetto del messaggio:  Re: FIX di modellazione CAD

Piccolo "update".
Ho aggiunto 4 volte un comando di questo tipo.
Codice:
                  (command "DONUT" "0" "1" (cdr(assoc 10 ed)) "")

creando una riga successiva al " (prompt "\n*DONE*") " ... il primo assoc 10, poi 11, 12, 13 ...
Crea un "donut", (un bollino ad anello), posizionato dove il programma ha corretto l'errore, ossia sul vertice unificato.
Può essere utile per vari motivi per capire dove fosse l'errore.
Attenzione che è in Lisp ma per semplicità non tocca il database agendo a basso livello come il resto. Scrive invece un comando diretto, in pratica "digita" al posto vostro come se scriveste sulla tastiera. Può darsi che su varie versioni di AutoCAD e IntelliCAD la sequenza degli input vada adattata.
Nel mio sw il comando Donut lo do così, e ho quindi ripetuto in codice Lisp questa sequenza, che può non essere standard :
Cita:
Donut (comando)
0 (diametro interno)
1 (diametro esterno)
coordinate del centro del "donut"
Enter

Pagina 1 di 1 Tutti gli orari sono UTC + 1 ora [ ora legale ]
Powered by phpBB® Forum Software © phpBB Group
https://www.phpbb.com/