Lisp mesh to solidify

[mikL44]

Salut à tous

 

Quelqu'un pourrait il me dire pourquoi ce programme ne fonctionne pas ?

Je bute dessus je n'arrive pas à trouver.

 

Merci

 

Boris

 

-----------------------------------------------------------------------------------------------------------

 

;; M2S (Mesh-to-Solid)

;; Creates an ACIS solid from an open 3d polygon mesh.

;;

;; Take 2 - Updated 7/7/1998

;; - Works with REVSURF'd meshes that touch or cross axis of revolution.

;; - Works even if solid being constructed is not fully visible on screen.

;; - Works with all open meshes created with REVSURF, RULESURF,

;; EDGESURF, TABSURF, AI_MESH, and 3DMESH. Most of the stock 3D

;; surfaces will work if you use DDMODIFY to open them in the M

;; and N directions.

;; - Does not work with polyface entities.

;;

;; © Copyright 1998 Bill Gilliss.

;; All rights reserved... such as they are.

;;

;; bill.gilliss@aya.yale.edu gilliss@iglou.com

;;

;; I wrote this to create sculptable ACIS terrain models

;; for architectural site renderings. It could also be used

;; to create thin shells from meshes, by subtracting a moved

;; copy of the solid from the original solid. Let me know of

;; other uses you find for it, or problems you encounter.

;;

;; The solid is created by projecting each mesh facet "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.

;;

;; The solid will match the displayed mesh: if the mesh has

;; been smoothed and SPLFRAME is set to 0, the solid will be

;; smoothed. Otherwise, it will not be. The mesh itself is not

;; changed at all.

;;

 

 

(defun c:m2s (/ ent ename entlst M N MN SN SM ST smooth oldecho vtx d1

low vtxcnt vtxmax bot bottom p1 p2 p3 p4 c1 c2 c3 c4

b1 b2 b3 b4 soldepth ssall ssrow)

 

(setq oldecho (getvar "cmdecho"))

(setq oldsnap (getvar "osmode"))

(setq oldblip (getvar "blipmode"))

(setvar "cmdecho" 0)

(setvar "osmode" 0)

(setvar "blipmode" 0)

(command "_undo" "debut")

 

;;select the mesh

(setq ent (entsel "Select a polygon mesh to solidify: "))

(setq ename (car ent))

(setq entlst (entget ename))

 

(if (not (= (cdr (assoc 0 entlst)) "_pline"))

(progn

(alert "That is not a polygon mesh.")

(exit)

(princ)

);progn

);endif

 

(if

(not

(or

(= (cdr (assoc 70 entlst)) 16) ;open 3d polygon mesh

(= (cdr (assoc 70 entlst)) 20) ;open mesh w/ spline-fit vertices

);or

);not

(progn

(alert "That is not an *open* polygon mesh.")

(exit)

(princ)

);progn

);endif

 

;; decide whether to use smoothed or unsmoothed vertices

(setq M (cdr (assoc 71 entlst))) ;M vertices

(setq N (cdr (assoc 72 entlst))) ;N vertices

(setq SM (cdr (assoc 73 entlst))) ;smoothed M vertices

(setq SN (cdr (assoc 74 entlst))) ;smoothed N vertices

(setq ST (cdr (assoc 75 entlst))) ;surface type

(if

(or

(= (getvar "splframe") 1) ;use MxN vertices when splframe = 1

(= ST 0) ;or mesh has not been smoothed

)

(setq smooth 0

MN (* M N))

(setq smooth 1 ;use SMxSN vertices when mesh is smoothed

MN (* SM SN) ;and SPLFRAME = 0

M SM

N SN)

);if

 

;; determine lowest vertex

(grtext -2 "Checking out the mesh...")

(setq vtx ename)

(setq vtx (entnext vtx))

(setq d1 (entget vtx))

(setq bottom (caddr (trans (cdr (assoc 10 d1)) 0 1)))

 

(repeat (1- MN) ;compare with each vertex's z coord

(setq vtx (entnext vtx))

(setq d1 (entget vtx))

(setq low (caddr (trans (cdr (assoc 10 d1)) 0 1)))

(setq bottom (min bottom low))

);repeat

 

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

 

(setq p1 ename)

(if (= smooth 1)

(setq p1 (entnext p1))) ;skip 1st vtx of smoothed mesh - not true vtx

(setq ssrow (ssadd)) ;initialize set of extruded segments to be unioned as a row

(setq ssall (ssadd)) ;initialize set of rows to be unioned into the whole

(grtext -2 "Creating row...")

(setq vtxmax (- MN N))

(setq vtxcnt 1)

 

;;create row of solid segments

(while (< vtxcnt vtxmax)

 

(if (= 0 (rem vtxcnt N)) ;at end of each row...

(progn

(setq rowmsg (strcat "Unioning row "

(itoa (/ vtxcnt N)) " of "

(itoa (1- M)) "... "))

(grtext -2 rowmsg)

(command "union" ssrow "")

(setq row (entlast))

(ssadd row ssall)

(setq ssrow (ssadd))

(setq p1 (entnext p1) ;skip to the next vertex

vtxcnt (1+ vtxcnt))

);progn

);if

 

(grtext -2 "Creating row...")

(setq p1 (entnext p1) ;first vertex of mesh square

p2 (entnext p1) ;second vertex

p3 p2)

(repeat (1- n) (setq p3 (entnext p3))) ;walk along to 3rd (p1 + N) vertex

(setq p4 (entnext p3)) ;4th vertex of mesh square

 

(setq c1 (trans (cdr (assoc 10 (entget p1))) 0 1) ;top coordinates

c2 (trans (cdr (assoc 10 (entget p2))) 0 1)

c3 (trans (cdr (assoc 10 (entget p3))) 0 1)

c4 (trans (cdr (assoc 10 (entget p4))) 0 1)

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 c2 c3 c4 b2 b3 b4)

 

(setq vtxcnt (1+ vtxcnt))

);while

 

(grtext -2 "Unioning last row...")

(command "union" ssrow "")

(setq row (entlast))

(ssadd row ssall)

(if (> M 2) ;bypass final union for N x 1 meshes (i.e., RULESURF)

(progn

(grtext -2 "Unioning all rows...")

(command "union" ssall "")

);progn

);if

 

;;cleanup

(command "_undo" "end")

(setvar "cmdecho" oldecho)

(setvar "osmode" oldsnap)

(setvar "blipmode" oldblip)

(setq ssall nil ssrow nil)

(princ)

 

);defun

 

;;============== SUBROUTINES ====================

;(defun *error* (msg)

; (command)

; (command "_undo" "end")

; (setvar "cmdecho" oldecho)

; (setvar "osmode" oldsnap)

; (setvar "blipmode" oldblip)

; (princ (strcat "\nError: " msg))

; );defun

 

(defun LOFT (r1 r2 r3 s1 s2 s3 / e1 extr highest)

(command "area" s1 s2 s3 "")

(if (not (equal (getvar "area") 0.0 0.00000001))

(progn

(command "pline" s1 s2 s3 "c")

(setq highest (max (caddr r1) (caddr r2) (caddr r3)))

(setq extr (- highest bot))

(command "extrude" (entlast) "" extr 0.0)

(command "slice" (entlast) "" "3points" r1 r2 r3 s1)

(setq e1 (entlast))

(ssadd e1 ssrow)

);progn

);if

);defun

 

(princ "M2S loaded.")

 

-----------------------------------------------------------------------------------------------------------------

[(gile)]

Salut,

 

Là tout de suite je n'ai pas le temps de le décortiquer, mais voilà une version que j'ai très légèrement modifiée et qui fonctionne. si tu veux faire une comparison.

 

;;    M2S  (Mesh-to-Solid)
;;
;;    Crée un solide ACIS à partir d'une surface maillée 3D ouverte.
;;    Modifié le 10/04/05 - Gilles Chanteau -
;;    Ajout des fonctions getval / std_err / save&set_var / restore_var
;;    Traduction des invites
;;
;;    Take 2 - Updated 7/7/1998
;;       - Works with REVSURF'd meshes that touch or cross axis of revolution.
;;       - Works even if solid being constructed is not fully visible on screen.
;;       - Works with all open meshes created with REVSURF, RULESURF,
;;          EDGESURF, TABSURF, AI_MESH, and 3DMESH. Most of the stock 3D
;;          surfaces will work if you use DDMODIFY to open them in the M
;;          and N directions.
;;       - Does not work with polyface entities.
;;
;;    (c) Copyright 1998 Bill Gilliss.  
;;        All rights reserved... such as they are.
;;
;;    bill.gilliss@aya.yale.edu    gilliss@iglou.com
;;
;;       I wrote this to create sculptable ACIS terrain models
;;    for architectural site renderings. It could also be used
;;    to create thin shells from meshes, by subtracting a moved
;;    copy of the solid from the original solid. Let me know of
;;    other uses you find for it, or problems you encounter.
;;
;;       The solid is created by projecting each mesh facet "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.
;;
;;       The solid will match the displayed mesh: if the mesh has
;;    been smoothed and SPLFRAME is set to 0, the solid will be
;;    smoothed. Otherwise, it will not be. The mesh itself is not
;;    changed at all.

;;; Redéfinition de *error*
(defun STD_ERR	(msg)
 (if (or
(= msg "Fonction annulée")
(= msg "quitter / sortir abandon")
     )
   (princ)
   (princ (strcat "\nErreur: " msg))
 )
 (command)
 (command "_undo" "_end")
 (RESTORE_VAR)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;; SAVE&SET_VAR & RESTORE_VAR
;;;
;;; SAVE&SET_VAR Enregistre la valeur initiale de la variable système dans une liste associative
;;; et lui attribue sa nouvelle valeur
;;; ex: (SAVE&SET_VAR "osmode" 0) -> !varlist (("osmode" . 43)) (getvar "osmode") 0
(defun SAVE&SET_VAR (var val)
 (cond
   ((not (getvar var))
    (princ (strcat "\nErreur: variable AutoCAD rejetée: " var))
    (princ)
   )
   ((/= (getvar var) val)
    (if (not (member (assoc var lst_var) lst_var))
      (setq lst_var (cons (cons var (getvar var)) lst_var))
    )
    (setvar var val)
   )
 )
)

;;; RESTORE_VAR Restaure leurs valeurs initiales aux variables système de "varlist"
(defun RESTORE_VAR ()
 (foreach pair	varlist
   (if	(/= (getvar (car pair)) (cdr pair))
     (setvar (car pair) (cdr pair))
   )
 )
 (setq varlist nil)
)

;;; GETVAL (Reini Urban) Retourne la première valeur du groupe d'une entité.
;;; Accepte tous les genres de représentations de l'entité
;;; (ename, les listes entget, les listes entsel)
;;; NOTE:  Ne peut obtenir que le premier groupe 10 dans LWPOLYLINE !

(defun getval (grp ele)					    ; "valeur dxf" de toute entité.
 (cond
   ((= (type ele) 'ENAME)				    ; ENAME
    (cdr (assoc grp (entget ele)))
   )  
   ((not ele) nil)                                                ; pas d'élément
   ((not (listp ele)) nil)				           ; élément invalide
   ((= (type (car ele)) 'ENAME)			    ; liste entsel
    (cdr (assoc grp (entget (car ele))))
   )
   (T (cdr (assoc grp ele)))				    ; liste entget
 )
)

;;; M2S Fonction principale
(defun c:m2s (/	    ent	  M	N     MN    SN	  SM	ST    smooth	  vtx	d1    low   vtxcnt
      vtxmax	  bot	bottom	    p1	  p2	p3    p4    c1	  c2	c3    c4    b1
      b2    b3	  b4	soldepth    ssall ssrow
     )

 (setq	m:err	*error*
*error*	STD_ERR
 )
 (command "_undo" "_begin")
 (SAVE&SET_VAR "cmdecho" 0)
 (SAVE&SET_VAR "osmode" 0)
 (SAVE&SET_VAR "blipmode" 0)
 (princ "M2S")

 ;;select the mesh
 (setq	ent (car (entsel
	   "\nSélectionnez une maille polygonale à solidifier: "
	 )
    )
 )

 (if (not (= (getval 0 ent) "POLYLINE"))
   (progn
     (alert "Ce n'est pas une maille polygonale.")
     (exit)
     (princ)
   )
 )

 (if
   (not
     (or
(= (getval 70 ent) 16)				    ;open 3d polygon mesh
(= (getval 70 ent) 20)				    ;open mesh w/ spline-fit vertices
     )
   )
    (progn
      (alert "Ce n'est pas une maille polygonale \"ouverte\".")
      (exit)
      (princ)
    )
 )

 ;; decide whether to use smoothed or unsmoothed vertices
 (setq	M  (getval 71 ent)				    ;M vertices
N  (getval 72 ent)				    ;N vertices
SM (getval 73 ent)				    ;smoothed M vertices
SN (getval 74 ent)				    ;smoothed N vertices
ST (getval 75 ent)				    ;surface type
 )							    
 (if
   (or
     (= (getvar "splframe") 1)				    ;use MxN vertices when splframe = 1
     (= ST 0)						    ;or mesh has not been smoothed
   )
    (setq smooth 0
   MN (* M N)
    )
    (setq smooth 1					    ;use SMxSN vertices when mesh is smoothed 
   MN	  (* SM SN)				    ;and SPLFRAME = 0
   M	  SM
   N	  SN
    )
 )

 ;; determine lowest vertex
 (grtext -2 "Contrôle de la maille...")
 (setq	vtx    ent
vtx    (entnext vtx)
d1     (entget vtx)
bottom (caddr (trans (cdr (assoc 10 d1)) 0 1))
 )


 (repeat (1- MN)					    ;compare with each vertex's z coord
   (setq vtx	 (entnext vtx)
  d1	 (entget vtx)
  low	 (caddr (trans (cdr (assoc 10 d1)) 0 1))
  bottom (min bottom low)
   )
 )


 ;; get desired thickness of solid
 (setq soldepth 0)
 (while (zerop soldepth)
   (setq soldepth
   (getdist
     "\nEntrez l'épaisseur du solide sous le point le plus bas : "
   )
   )
   (if	(not soldepth)
     (setq soldepth 1.0)
   )
   (if	(zerop soldepth)
     (princ
"\nL'épaisseur peut être faible, mais pas égale à zéro.\n(Couper ensuite, si nécessaire.)"
     )
   )
 )
 (setq bot (- bottom (abs soldepth)))

 (setq p1 ent)
 (if (= smooth 1)
   (setq p1 (entnext p1))
 )							    ;skip 1st vtx of smoothed mesh - not true vtx
 (setq	ssrow (ssadd)					    ;initialize set of extruded segments to be unioned as a row
ssall (ssadd)
 )							    ;initialize set of rows to be unioned into the whole
 (grtext -2 "Création de la rangée...")
 (setq	vtxmax (- MN N)
vtxcnt 1
 )

 ;;create row of solid segments
 (while (
   (if	(= 0 (rem vtxcnt N))				    ;at end of each row...
     (progn
(setq rowmsg (strcat "Union de la rangée... "
		     (itoa (/ vtxcnt N))
		     " de "
		     (itoa (1- M))
		     "... "
	     )
)
(grtext -2 rowmsg)
(command "_union" ssrow "")
(setq row (entlast))
(ssadd row ssall)
(setq ssrow  (ssadd)
      p1     (entnext p1)			    ;skip to the next vertex
      vtxcnt (1+ vtxcnt)
)
     )
   )

   (grtext -2 "Création de la rangée...")
   (setq p1 (entnext p1)				    ;first vertex of mesh square
  p2 (entnext p1)				    ;second vertex
  p3 p2
   )
   (repeat (1- n) (setq p3 (entnext p3)))		    ;walk along to 3rd (p1 + N) vertex
   (setq p4 (entnext p3)				    ;4th vertex of mesh square
  c1 (trans (cdr (assoc 10 (entget p1))) 0 1)	    ;top coordinates
  c2 (trans (cdr (assoc 10 (entget p2))) 0 1)
  c3 (trans (cdr (assoc 10 (entget p3))) 0 1)
  c4 (trans (cdr (assoc 10 (entget p4))) 0 1)
  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 c2 c3 c4 b2 b3 b4)

   (setq vtxcnt (1+ vtxcnt))
 )

 (grtext -2 "Union de la denière rangée...")
 (command "_union" ssrow "")
 (setq row (entlast))
 (ssadd row ssall)
 (if (> M 2)						    ;bypass final union for N x 1 meshes (i.e., RULESURF)
   (progn
     (grtext -2 "Union de toutes les rangées...")
     (command "_union" ssall "")
   )
 )

 ;;cleanup
 (command "_undo" "_end")
 (RESTORE_VAR)
 (setq	ssall nil
ssrow nil
*error*	m:err
m:err nil
 )
 (princ)

)

;;============== SUBROUTINE ====================

(defun LOFT (r1 r2 r3 s1 s2 s3 / e1 extr highest)
 (command "_area" s1 s2 s3 "")
 (if (not (equal (getvar "area") 0.0 0.00000001))
   (progn
     (command "_pline" s1 s2 s3 "c")
     (setq highest (max (caddr r1) (caddr r2) (caddr r3)))
     (setq extr (- highest bot))
     (command "_extrude" (entlast) "" extr 0.0)
     (command "_slice" (entlast) "" "_3points" r1 r2 r3 s1)
     (setq e1 (entlast))
     (ssadd e1 ssrow)
   )
 )
)

[Edité le 13/9/2005 par (gile)]

 

[Edité le 26/12/2005 par (gile)]

[mikL44]

Merci beaucoup Gile, c'est génial pour modéliser un terrain en 3dsolid à partir d'une _edgesurf

 

Encore Merci

 

Tchao

[(gile)]

Re,

 

Si ta version de M2S ne marchait pas c'est uniquement un problème de mauvaise traduction :

 

Remplacement de "POLYLINE" (type d'objet) par "_pline" (commande) dans le test sur l'objet au début :

(if (not (= (cdr (assoc 0 entlst)) "_pline"))

 

et d'utilisation de l'anglais dans des appels de commandes dans la sous routine LOFT :

"pline" "c" "extrude" ainsi que l'option "end" de la commande "_undo" à la fin.

Il eut fallu écrire "_pline" "_c" "_extrude" "_end" et aussi "_3points" "_area" même si les 2 dernières sont les mêmes en anglais et en français.

 

À ce sujet