Au secours sur F2S

[thierry.garré]

Bonsoir à tous,

 

j'utilise ce lisp pour transformer un MNT (3dfaces) en solide sur 2008 sans probleme , mais en 2010 y fonctionne plus du tout!!!!!

 

Et comme je suis une bille en lisp je suis incapable de savoir d'ou cela vient

 

à l'aide

 

PS je repond 1 à la premiere question et Auto à la seconde

 

;|   F2S.lsp  (Faces-to-Solid)
Creates a single ACIS solid from selected 3dfaces, touching or not

(c) Copyright 2006 by Bill Gilliss.
All rights reserved... such as they are. 
Comments and suggestions always welcome.

bill.gilliss@<<NOSPAM>>aya.yale.edu    gilliss@<<NOSPAM>>iglou.com

Version: 1.01
Date:    8/26/2006

Release Notes:
1.00  8/23/2006  Original release
1.01  8/26/2006  SPLFRAME=1 to be sure faces are visible and therefore selectable
                polyline area threshold increased to prevent solid creation errors

Summary:
As in M2S.lsp, the solid is created on the current layer by projecting each 
selected face vertically "down" the CURRENT z-axis to a plane a user-specified 
distance below the lowest vertex. To assure that all parts of the mesh are 
generated as solids, this distance can not be zero, but the solid can be SLICEd
later if need be.

Notes:
- Works with AutoCAD 2007 as well as all previous releases that support 3D solids.

- Thanks to Gilles Chanteau for R2007 and international syntax suggestions.

- If adjacent faces do not have identical coordinates, there will be very 
small gaps or overlaps between the solids derived from them, which can 
cause AutoCAD to fail to be able to union the solids. Common results:
     "Inconsistent containment of intersection curve."
     "Inconsistent information in vertex and coedge coordinates."
     "Inconsistent edge-face relationships."
     "Inconsistent face-body relationships."
     "Curves osculate at vertex - cannot evaluate order."
  Many thanks to Robert Morin for suggesting that, for AutoCAD 2006 and earlier,
the best way to fix the face vertices before running F2S is to use 3DSOUT with 
Auto-Welding turned on with an appropriate threshold, then 3DSIN to bring the welded
mesh back into AutoCAD, then EXPLODE and run F2S. The larger the threshold distance,
the fewer the problems. (R2007 does not have 3DSOUT, alas.)
  VIZ or 3DS MAX can also do the vertex welding when importing an AutoCAD file.
If one of these are available, save or wblock the faces to a new DWG file, and then
import the new file into VIZ with Weld turned on with an appropriate threshold. 
Export to 3DS format, and then use 3DSIN in AutoCAD.
  The ANNEAL command in EasySite from Cadeasy Corp. will also fix the 3dface vertices 
with a user-specified tolerance, without leaving AutoCAD.
  If problematic solids do persist, copying them a small distance and then 
unioning the copies with the original will usually fill the gaps and resolve
these problems.
  Some manual unioning might still be necessary with any of these approaches --
deal with it.
|;

(defun c:f2s ( / ss ent ed bot bottom partialsolid R17 n partialsolid num
                low10 low11 low12 low13
                p1 p2 p3 p4 c1 c2 c3 c4 b1 b2 b3 b4
                soldepth sspartial ssfinal
                oldsolidhist oldecho oldsnap oldblip oldsplframe
                )

(setq oldecho (getvar "cmdecho"))
(command "_.undo" "_begin")
(setq oldsnap (getvar "osmode"))
(setq oldblip (getvar "blipmode"))
(setq oldsplframe (getvar "splframe"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "blipmode" 0)
(setvar "splframe" 1)                   ;; edges must be visible for 
(command "_.regen")                     ;; faces to be selectable
(if (< 16 (atoi (substr (getvar "acadver") 1 2))) (setq R17 T))
(if R17 (setq oldsolidhist (getvar "solidhist")))
(if R17 (setvar "solidhist" 0))

;;select the faces
 (prompt "Select 3dface(s) to solidify: ")
 (setq ss (ssget '((0 . "3dface"))))

;;initialize lowest value
 (setq ent (ssname ss 0))
 (setq ed (entget ent))
 (setq bottom (caddr (trans (cdr (assoc 10 ed)) 0 1)))  

;;find lowest vertex in selection set of faces 
 (setq n 0)
   (while                         
   (< n (sslength ss)) 
   (progn 
     (setq ent (ssname ss n))
     (setq ed (entget ent))
     (setq low10 (caddr (trans (cdr (assoc 10 ed)) 0 1)))
     (setq low11 (caddr (trans (cdr (assoc 11 ed)) 0 1)))
     (setq low12 (caddr (trans (cdr (assoc 12 ed)) 0 1)))
     (setq low13 (caddr (trans (cdr (assoc 13 ed)) 0 1)))
     (setq bottom (min bottom low10 low11 low12 low13))
     (setq n (1+ n))
     );progn
 );while

;; get desired thickness of solid
 (setq soldepth 0)
 (while
    (zerop soldepth)
    (progn
      (setq soldepth (getdist "\nEnter desired thickness of solid below lowest vertex <1>: "))
      (if (not soldepth) (setq soldepth 1.0))
      (if (zerop soldepth)
         (princ "\nThickness can be small, but not zero. (Slice it later, if need be.)"))
      );progn
    );while
 (setq bot (- bottom (abs soldepth)))

;; initialize selection sets to receive solids  
 (setq sspartial (ssadd))          ;initialize partial set of extruded segments to be unioned together
 (setq ssfinal (ssadd))            ;initialize final set of solids
 
 (princ "\nUnioning large number of small solids can lock up AutoCAD")
 (princ "\nif memory limits are exceeded. Would you like to continue")
 (princ "\nwith automatic unioning, or union them manually?")
 (initget 1 "Auto Manual")
 (setq reply (getkword " Auto or Manual?"))
 (setq reply (substr reply 1 1))

;;create solids
(setq num (sqrt (sslength ss)))  ;;number of partial solids to create
(setq n 0)
(setq partialsolid 0)
(setq time1 (getvar "DATE"))

(while 
 (< n (sslength ss))
 (progn 
   (setq ent (ssname ss n))
   (setq ed (entget ent))
   (setq p1 (assoc 10 ed)                 ;first vertex of face
         p2 (assoc 11 ed)
         p3 (assoc 12 ed)
         p4 (assoc 13 ed))
   (setq c1 (trans (cdr p1) 0 1)          ;top coordinates
         c2 (trans (cdr p2) 0 1)
         c3 (trans (cdr p3) 0 1)
         c4 (trans (cdr p4) 0 1))
   (setq b1 (list (car c1) (cadr c1) bot) ;bottom coordinates
         b2 (list (car c2) (cadr c2) bot)
         b3 (list (car c3) (cadr c3) bot)
         b4 (list (car c4) (cadr c4) bot))
   (LOFT c1 c2 c3 b1 b2 b3)
   (LOFT c3 c4 c1 b3 b4 b1)
   (setq partialsolid (1+ partialsolid))

   (if 
    (or (>= partialsolid num) (= n (1- (sslength ss))))
     (if (= reply "A")
       (progn
         (setq partialsolid 0) 
         (command "_.union" sspartial "")
         (ssadd (entlast) ssfinal)
         (setq sspartial (ssadd))   ;;re-initialize with empty set      
         );progn
       );if 
     );if
 (progress n (sslength ss)) 
  (setq n (1+ n))         
 );progn 
);while

(if (= reply "A")
 (progn
   (grtext -1 "Unioning final solid...")
   (command "_.union" ssfinal "")
   );progn
 );if
   
;;cleanup
 (setvar "osmode" oldsnap)
 (setvar "blipmode" oldblip)
 (setvar "splframe" oldsplframe)
 (if R17 (setvar "solidhist" oldsolidhist))
 (setq sspartial nil 
       ssfinal nil)
 (command "_.undo" "_end")
 (grtext)
 (setvar "cmdecho" oldecho)
 (princ)

);defun

;;============== SUBROUTINES ====================
(defun LOFT (r1 r2 r3 s1 s2 s3 / e1 extr highest)
 (command "_.area" s1 s2 s3 "")
 (if (> (getvar "area") 0.000001) ;;avoid problems with tiny solids
   (progn
     (command "_.pline" s1 s2 s3 "c")
     (setq highest (max (caddr r1) (caddr r2) (caddr r3)))
     (setq extr (- highest bot))
     (if 
       R17
       (command "_.extrude" (entlast) "" extr)     ;;2007 and higher 
       (command "_.extrude" (entlast) "" extr 0.0) ;;2006 and below
       );endif

     (if                  ;;don't slice if top is flat
      (not
       (and 
         (equal (caddr r1) (caddr r2)) 
         (equal (caddr r1) (caddr r3))
         );and
        );not
      (command "_.slice" (entlast) "" "_3points" r1 r2 r3 s1)
      );if
    (ssadd (entlast) sspartial)
    );progn
   );if
 );defun
 

(defun progress (current total / time2 time3 elapsed complete   ;;time1 is a global variable
                projected r days hours minutes seconds message)
(if
 (and (> current 0)                 ;;skip first one to avoid divide by 0
      (= 0 (rem (fix current) 10))  ;;only update every 10th iteration
      );and
   (progn
    (if (not time1) (setq time1 (getvar "date")))  ;initialize here if neglected in calling code
    (setq time2 (getvar "date"))
    (setq time3 (- time2 time1))
    (setq elapsed (* 86400 time3))           ;;elapsed time in seconds
    (setq complete (/ current total 1.0))    ;;decimal value betw 0.0 and 1.0
        (setq projected (/ elapsed complete))  ;;projected time in seconds
        (setq r (- projected elapsed))         ;;remaining time in seconds
        (setq 
          days     (fix (/ r 86400))
          r        (- r (* days 86400))      
          hours    (fix (/ r 3600))
          r        (- r (* hours 3600))
          minutes  (fix (/ r 60))
          r        (- r (* minutes 60))
          seconds  (fix r)
          )
        (setq message 
          (strcat 
           "% complete:" 
           (if 
            (< (* 100 complete) 10)
            (strcat "0" (itoa (fix (* 100 complete))))
            (itoa (fix (* 100 complete)))
            )
          "  Remaining:"
          (itoa days) ":"
          (itoa hours) ":"
          (if (< minutes 10)(strcat "0" (itoa minutes))(itoa minutes) ) ":"
          (if (< seconds 10)(strcat "0" (itoa seconds))(itoa seconds) )
          );strcat
       );setq
     (grtext -1 message)
  );progn
 );if
);defun

(alert 
"Face-to-Solid loaded. Type  F2S  to run the program.
\nNote: if many faces are selected, AutoCAD may crash due to memory
limitations when unioning the many solids created from them, so please 
\nSAVE ALL OPEN DRAWINGS \n
before using this routine with large numbers of faces. The routine
will prompt for automatic or manual unioning; select manual to do the 
unioning yourself in smaller increments if automatic causes problems.
\nAlso, see the introductory comments in the LISP file about cleaning up
face coordinates to avoid unioning errors.")

[didier]

Bonsoir Thierry

 

je ne suis pas allé bien loin dans la decortication de ce lisp

mais une première chose me saute aux yeux,

ceci :

 

(if (

(if R17 (setq oldsolidhist (getvar "solidhist")))

(if R17 (setvar "solidhist" 0))

 

a priori il n'est pas prévu de travailler en version supérieure à 2008 voire 2009.

 

je pense que des plus calés que moi viendront te répondre plus précisément.

 

je te salue depuis l'hémisphère sud...

 

amicalement

[thierry.garré]

Merci Didier de ta réponse,

 

Je me doutais bien d'un soucis de ce genre......

 

 

.....Toujours à l'aide toutefois si quelqu'un a un peu de temps

 

 

PS: t'es ou dans l'hémisphère sud? Mada ?

[thierry.garré]

Problème résolu par l'auteur du Lisp en aout 2010

 

Donc tout va bien

 

si dessous le code de ce lisp fabuleux

 

cordialement

 

 

;|   F2S.lsp  (Faces-to-Solid)
Creates a single ACIS solid from selected 3dfaces, touching or not

by Bill Gilliss
bill at realerthanreal dot com
Comments and suggestions always welcome.

No warranty, either expressed or implied, is made as to the fitness of
this information for any particular purpose.  All materials are to be
considered 'as-is', and use thereof should be considered as at your own
risk.

Release Notes:
1.00  8/23/2006  - Original release.
1.01  8/26/2006  - SPLFRAME=1 to be sure faces are visible and therefore selectable.
                - polyline area threshold increased to prevent solid creation errors.
1.02  8/28/2006  - international syntax fix.
1.03  7/13/2007  - Option added to erase faces as they are converted to solids.
1.10   3/8/2010  - 2010 compatible (change in AREA command) and rewritten as modular code
                - ExpressTools progress bar added, if ET installed
                - GRIDMODE set to prevent flicker

Summary:
 As in M2S.lsp, the solid is created on the current layer by projecting each
selected face vertically "down" the CURRENT z-axis to a plane a user-specified
distance below the lowest vertex. To assure that all parts of the mesh are
generated as solids, this distance can not be zero, but the solid can be SLICEd
later if need be.
 Quite complex solids can be created by projecting the faces along several different
axes, then using INTERFERE or INTERSECT to create the final solid from the
intermediate ones.

Notes:
- Thanks to Gilles Chanteau, Dr. Heinz-Joachim Schulz, and Robert Morin
- Works with all releases that support 3D solids.
- If adjacent faces do not have identical coordinates, there will be very
small gaps or overlaps between the solids derived from them, which can
cause AutoCAD to fail to be able to union the solids. Common results:
     "Inconsistent containment of intersection curve."
     "Inconsistent information in vertex and coedge coordinates."
     "Inconsistent edge-face relationships."
     "Inconsistent face-body relationships."
     "Curves osculate at vertex - cannot evaluate order."
 The best way to fix the face vertices before running F2S is to use 3DSOUT
with Auto-Welding turned on with an appropriate threshold, then 3DSIN to bring
the welded mesh back into AutoCAD, then EXPLODE and run F2S. The larger the
threshold distance, the fewer the problems.
  3DS MAX and Rhino can also do the vertex welding when importing an AutoCAD file.
If one of these are available, save or wblock the faces to a new DWG file, and then
import the new file with Weld turned on with an appropriate threshold.
Export to 3DS format, and then use 3DSIN in AutoCAD.
  The ANNEAL command in EasySite from Cadeasy Corp will also fix the 3dface vertices
with a user-specified tolerance, without leaving AutoCAD.
  If problematic solids do persist, copying them a small distance and then
unioning the copies with the original will usually fill the gaps and resolve
these problems.
  Some manual unioning might still be necessary with any of these approaches --
deal with it.

Keywords: AutoCAD AutoLISP 3dsolid 3dface face convert
=========================================================================
|;
(defun c:f2s (/ ss ent ed bot bottom partialsolid R17 n partialsolid num
                low10 low11 low12 low13
                p1 p2 p3 p4 c1 c2 c3 c4 b1 b2 b3 b4
                soldepth sspartial ssfinal ETloaded
                *solidhist *cmdecho *osmode *blipmode *splframe
                myerror setup getFaces getLowestVertex getThickness initializeSets
                createSolids unionSolids getPoints area3p F2SLoft
                )

;;-----subroutines----------------
(defun myerror (msg)
 (princ msg)
 (setvar 'osmode    *osmode)
 (setvar 'blipmode  *blipmode)
 (setvar 'delobj    *delobj)
 (setvar 'splframe  *splframe)
 (setvar 'solidhist *solidhist)
 (setvar 'gridmode *gridmode)
 (if ETloaded (acet-ui-progress))
 (command "_.undo" "_end")
 (setq *error* olderror)
 (setvar 'cmdecho *cmdecho)
 (princ)
)

(defun setup ()
 (command "_.undo" "_begin")
 (setq *cmdecho (getvar 'cmdecho))
 (setq *osmode   (getvar 'osmode))
 (setq *blipmode (getvar 'blipmode))
 (setq *delobj   (getvar 'delobj))
 (setq *splframe (getvar 'splframe))
 (setq *gridmode (getvar 'gridmode))
 (setvar 'cmdecho 0)
 (setvar 'osmode 0)
 (setvar 'blipmode 0)
 (setvar 'delobj 1)
 (setvar 'splframe 1)  ;; edges must be visible for faces to be selectable
 (setvar 'gridmode 0)  ;; avoids flicker 
 (command "_.regen")
 (if (< 16 (atoi (substr (getvar "acadver") 1 2))) (setq R17 T))
 (if R17 (setq *solidhist (getvar 'solidhist)))
 (if R17 (setvar 'solidhist 0))
 (if (member "acetutil.arx" (arx))
   (setq ETloaded T)
   )
 (setq olderror *error*)
 (setq *error* myerror)

(alert
"Face-to-Solid loaded. Type  F2S  to run the program.
\nNote: if many faces are selected, AutoCAD may crash due to memory
limitations when unioning the many solids created from them, so please
\nSAVE ALL OPEN DRAWINGS \n
before using this routine with large numbers of faces. The routine
will prompt for automatic or manual unioning; select manual to do the
unioning yourself in smaller increments if automatic causes problems.
\nAlso, see the introductory comments in the LISP file about cleaning up
face coordinates to avoid unioning errors.")
)

(defun getFaces ()
 (prompt "Select 3dface(s) to solidify: ")
 (setq ss (ssget '((0 . "3dface"))))
 (initget 1 "Yes No")
 (setq erasefaces (getkword "Erase faces [Yes or No]: "))
)

(defun getLowestVertex ()
 (setq ent (ssname ss 0))
 (setq ed (entget ent))
 (setq bottom (caddr (trans (cdr (assoc 10 ed)) 0 1)))

 ;;find lowest vertex in selection set of faces
 (setq n 0)
   (while
   (< n (sslength ss))
   (progn
     (setq ent (ssname ss n))
     (setq ed (entget ent))
     (setq low10 (caddr (trans (cdr (assoc 10 ed)) 0 1)))
     (setq low11 (caddr (trans (cdr (assoc 11 ed)) 0 1)))
     (setq low12 (caddr (trans (cdr (assoc 12 ed)) 0 1)))
     (setq low13 (caddr (trans (cdr (assoc 13 ed)) 0 1)))
     (setq bottom (min bottom low10 low11 low12 low13))
     (setq n (1+ n))
     );progn
 );while
)

(defun getThickness ()
 (setq soldepth 0)
 (while
    (zerop soldepth)
    (progn
      (setq soldepth (getdist "\nEnter desired thickness of solid below lowest vertex <1>: "))
      (if (not soldepth) (setq soldepth 1.0))
      (if (zerop soldepth)
         (princ "\nThickness can be small, but not zero. (Slice it later, if need be.)"))
      );progn
    );while
 (setq bot (- bottom (abs soldepth)))
)

(defun initializeSets ()
 (setq sspartial (ssadd))  ;initialize partial set of extruded segments to be unioned together
 (setq ssfinal (ssadd))    ;initialize final set of solids

 (princ "\nUnioning large number of small solids can lock up AutoCAD")
 (princ "\nif memory limits are exceeded. Would you like to continue")
 (princ "\nwith automatic unioning, or union them manually?")
 (initget 1 "Auto Manual")
 (setq reply (getkword " Auto or Manual?"))
 (setq reply (substr reply 1 1))
)

(defun createSolids ()
 (if ETloaded (acet-ui-progress "Progress: " (sslength ss)))
 (setq num (sqrt (sslength ss)))  ;;number of partial solids to create
 (setq n 0)
 (setq partialsolid 0)
 (setq time1 (getvar "DATE"))
 (while
   (< n (sslength ss))
   (progn
     (getPoints)
     (F2SLoft c1 c2 c3 b1 b2 b3)
     (F2SLoft c3 c4 c1 b3 b4 b1)
     (if (= erasefaces "Yes") (entdel ent))
     (setq partialsolid (1+ partialsolid))

     (if
      (or (>= partialsolid num) (= n (1- (sslength ss))))
       (if (= reply "A")
         (progn
           (setq partialsolid 0)
           (command "_.union" sspartial "")
           (ssadd (entlast) ssfinal)
           (setq sspartial (ssadd))   ;;re-initialize with empty set
           );progn
         );if
       );if

     (if ETloaded (acet-ui-progress n))
    (setq n (1+ n))
   );progn
 );while
)

(defun unionSolids ()
 (if (= reply "A")
   (progn
     (grtext -1 "Unioning final solid...")
     (command "_.union" ssfinal "")
     );progn
   );if
)

(defun getPoints()
 (setq ent (ssname ss n))
 (setq ed (entget ent))
 (setq p1 (assoc 10 ed)                 ;first vertex of face
       p2 (assoc 11 ed)
       p3 (assoc 12 ed)
       p4 (assoc 13 ed))
 (setq c1 (trans (cdr p1) 0 1)          ;top coordinates
       c2 (trans (cdr p2) 0 1)
       c3 (trans (cdr p3) 0 1)
       c4 (trans (cdr p4) 0 1))
 (setq b1 (list (car c1) (cadr c1) bot) ;bottom coordinates
       b2 (list (car c2) (cadr c2) bot)
       b3 (list (car c3) (cadr c3) bot)
       b4 (list (car c4) (cadr c4) bot))
)

(defun F2SLoft (r1 r2 r3 s1 s2 s3 / e1 extr highest)
 (if (> (area3p s1 s2 s3) 0.000001) ;;avoid problems with tiny solids
   (progn
     (command "_.pline" s1 s2 s3 "_close")
     (setq highest (max (caddr r1) (caddr r2) (caddr r3)))
     (setq extr (- highest bot))
     (if
       R17
       (command "_.extrude" (entlast) "" extr)     ;;2007 and higher
       (command "_.extrude" (entlast) "" extr 0.0) ;;2006 and below
       );endif

     (if                  ;;don't slice if top is flat
      (not
       (and
         (equal (caddr r1) (caddr r2))
         (equal (caddr r1) (caddr r3))
         );and
        );not
      (command "_.slice" (entlast) "" "_3points" r1 r2 r3 s1)
      );if
    (ssadd (entlast) sspartial)
    );progn
   );if
 );defun

(defun area3p (p1 p2 p3 / a b c s)
(setq
	a (distance p1 p2)
	b (distance p2 p3)
	c (distance p3 p1)
	s (* 0.5 (+ a b c))
)
(sqrt
	(*
		s
		(- s a)
		(- s B)
		(- s c)
	)
)
)

;;========== MAIN ROUTINE =========================
 (setup)
 (getFaces)
 (getLowestVertex)
 (getThickness)
 (initializeSets)
 (createSolids)
 (unionSolids)
 (myerror nil) ;;cleanup

);defun F2S

[(gile)]

Salut,

 

J'ai essayé d'optimiser F2S (utilisation des méthodes vla-* et nouvel algorithme d'union des solides). La routine est environ deux fois et demi plus rapide.

 

(defun c:F2S (/		*error*	  clockwise-p	      3d-coord->pt-lst
      Triang2dArea	  space	    loft      ss
      alt	count	  coords    p1	      p2
      p3	p4	  lowest    solid     flst
      cnt	previous  slst	    tmp	      n
      i
     )

 ;; Redéfinition locale de *error*
 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\nErreur: " msg))
   )
   (setvar 'solidhist shist)
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 ;; Clockwise-p Retourne T si les points p1 p2 et p3 tournent dans le sens horaire
 (defun clockwise-p (p1 p2 p3)
   (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
 )

 ;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points
 (defun 3d-coord->pt-lst (lst)
   (if	lst
     (cons (list (car lst) (cadr lst) (caddr lst))
    (3d-coord->pt-lst (cdddr lst))
     )
   )
 )

 ;; Triang2dArea retourne l'aire du triangle (points 2d)
 (defun Triang2dArea (p1 p2 p3)
   (/ (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
  (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))
      )
      2.
   )
 )

 ;; extrusion et section des faces
 (defun loft (p1 p2 p3 / pline reg solid tmp)
   (if	(clockwise-p p1 p2 p3)
     (setq tmp	p2
    p2	p3
    p3	tmp
     )
   )
   (setq height (max (caddr p1) (caddr p2) (caddr p3))
  pline	 (vlax-invoke
	   space
	   'AddLightweightPolyline
	   (list (car p1)
		 (cadr p1)
		 (car p2)
		 (cadr p2)
		 (car p3)
		 (cadr p3)
	   )
	 )
   )
   (vla-put-Closed pline :vlax-true)
   (vla-put-Elevation pline alt)
   (setq reg	(car (vlax-invoke space 'AddRegion (list pline)))
  solid	(vla-AddExtrudedSolid space reg (- height alt) 0.0)
   )
   (if	(not (and (equal (caddr p1) (caddr p2) 1e-9)
	  (equal (caddr p1) (caddr p3) 1e-9)
     )
)
     (vla-SliceSolid
solid
(vlax-3d-point p1)
(vlax-3d-point p2)
(vlax-3d-point p3)
:vlax-false
     )
   )
   (vla-Delete reg)
   (vla-Delete pline)
   (vla-update solid)
   solid
 )

 ;; fonction principale
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (setq	space (vla-get-ModelSpace *acdoc*)
shist (getvar 'solidhist)
 )
 (if (setq ss (ssget '((0 . "3DFACE"))))
   (progn
     (initget 6)
     (setq alt
     (cond
       ((getdist
	  "\nEntrez la distance sous le point le plus bas <1>: "
	)
       )
       (1.)
     )
     )
     (initget 1 "Auto Manuel")
     (setq opt (getkword "\nUnion des solides [Auto/Manuelle]: "))
     (vla-StartUndoMark *acdoc*)
     (setvar 'solidhist 0)
     (vlax-for	f (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(setq coords (3d-coord->pt-lst (vlax-get f 'Coordinates))
      p1     (car coords)
      p2     (cadr coords)
      p3     (caddr coords)
      p4     (cadddr coords)
      lowest (if lowest
	       (apply 'min (cons lowest (mapcar 'caddr coords)))
	       (apply 'min (mapcar 'caddr coords))
	     )
)
(or (< (abs (Triang2dArea p1 p2 p3)) 1e-9)
    (setq flst (cons (list p1 p2 p3) flst))
)
(or (< (abs (Triang2dArea p3 p4 p1)) 1e-9)
    (setq flst (cons (list p3 p4 p1) flst))
)
     )
     (vla-delete ss)
     (setq alt (- lowest alt))
     (and acet-ui-progress
   (acet-ui-progress "Extrusion..." (length flst))
     )
     (setq n 0)
     (foreach l flst
(setq slst (cons (apply 'loft l) slst))
(and acet-ui-progress (acet-ui-progress (setq n (1+ n))))
     )
     (and acet-ui-progress (acet-ui-progress))
     (if (= opt "Auto")
(progn
  (and acet-ui-progress
       (acet-ui-progress "Union..." (length slst))
  )
  (setq i 0)
  (while (< 1 (setq cnt (length slst)))
    (if	(= 1 (rem cnt 2))
      (progn
	(vla-Boolean (cadr slst) acUnion (car slst))
	(and acet-ui-progress
	     (acet-ui-progress (setq i (1+ i)))
	)
	(vla-update (cadr slst))
	(setq slst (cdr slst)
	      cnt  (1- cnt)
	)
      )
    )
    (setq n   0
	  tmp nil
    )
    (repeat (/ cnt 2)
      (vla-Boolean (nth n slst) acUnion (nth (1+ n) slst))
      (and acet-ui-progress (acet-ui-progress (setq i (1+ i))))
      (vla-update (nth n slst))
      (setq tmp	(cons (nth n slst) tmp)
	    n	(+ 2 n)
      )
    )
    (setq slst tmp)
  )
  (and acet-ui-progress (acet-ui-progress))
)
     )
     (setvar 'solidhist shist)
     (vla-EndUndoMark *acdoc*)
   )
 )
 (princ)
)

 

J'ai aussi essayé avec .NET, mais le gain de performance n'est pas aussi important que je l'espérais. Le fait de partir de faces 3d nécessite de créer un solide par face puis d'unir tous ces solides.

 

Une méthode (.NET) où le gain de performances est beaucoup plus notable est possible depuis la version 2010 avec les nouveaux maillages en partant directement d'un semis de points (voir ici)

[(gile)]

Salut,

 

 

La version .NET (Face3dToSolid_17.dll pour AutoCAD 2007-2012, Face3dToSolid_17.dll pour AutoCAD 2013+)

Commande : Face2Solid