polysolide

[zaza_du_67]

bjr à tous !

 

une débutante !!! comment faire une polysolide sur la version complète 2006

merci d'avance.

 

[Edité le 1/5/2007 par zaza_du_67]

[(gile)]

Salut et bienvenue,

 

Il n'y a pas de commande "polysolid" dans les versions antérieures à la version 2007.

[fabcad]

Bonsoir,

qu'est-ce qu'un polysolid ?

 

fabcad

[Bred]

Salut,

Comme l'écrit (gile), la notion de "polysolide" (solide réaliser à partir d'une ligne, polyligne, etc...) n'apparait que dans la 2007.

Cette commande créés un "solide 3D".

 

Par contre, si tu veux donner une épaisseur à une polyligne, tu peux passer par les propriétés. Mais attention : l'objet reste une polyligne, et les opérations boléenne lui sont impossible !!!

 

http://images1.hiboox.com/images/1807/tkukfjj2.jpg

[(gile)]

Un petit LISP vite fait.

 

EDIT : Ajout de l'option "Objet"

 

EDIT 2 : réparé bug avec les splines fermées.

 

(defun c:polysolid (/ make_pline poly2solid loop pt larg haut ent)

 (vl-load-com)

 ;;==================================================================::

 (defun make_pline (pt larg haut / pw)
   (setq pw (getvar "plinewid"))
   (setvar "cmdecho" 0)
   (command "_.pline" pt "_w" larg "")
   (setvar "cmdecho" 1)
   (while (/= 0 (getvar "cmdactive"))
     (command pause)
   )
   (command)
   (setvar "plinewid" pw)
   (poly2solid (entlast) larg haut)
 )

 ;;==================================================================::

 (defun poly2solid (ent larg haut / AcDoc Space pl1 pl2 l1 l2 reg)
   (setq AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
  Space	(if (= 1 (getvar "CVPORT"))
	  (vla-get-PaperSpace AcDoc)
	  (vla-get-ModelSpace AcDoc)
	)
  ent	(vlax-ename->vla-object ent)
   )
   (vla-offset ent (/ larg 2))
   (setq pl1 (vlax-ename->vla-object (entlast)))
   (vla-offset ent (/ larg -2))
   (setq pl2 (vlax-ename->vla-object (entlast)))
   (if	(or
  (and (member (vla-get-objectName ent) '("AcDbPolyline" "AcDbSpline"))
       (= (vla-get-Closed ent) :vlax-true)
  )
  (= (vla-get-objectName ent) "AcDbCircle")
  (and (= (vla-get-objectName ent) "AcDbEllipse")
       (= (vla-get-StartAngle ent) 0.0)
       (= (vla-get-EndAngle ent) (* 2 pi))
  )
)
     (progn
(setq reg  (vlax-invoke Space 'addRegion (list pl1 pl2)))
(if (	  (progn
(vla-boolean (cadr reg) acSubtraction (car reg))
(setq reg (cadr reg))
)
  (progn
  (vla-boolean (car reg) acSubtraction (cadr reg))
  (setq reg (car reg))
  )
  )
     )
     (setq l1	(vla-addLine
	  space
	  (vlax-3d-point (vlax-curve-getStartPoint pl1))
	  (vlax-3d-point (vlax-curve-getStartPoint pl2))
	)
    l2	(vla-addLine
	  space
	  (vlax-3d-point (vlax-curve-getEndPoint pl1))
	  (vlax-3d-point (vlax-curve-getEndPoint pl2))
	)
    reg	(car (vlax-invoke Space 'addRegion (list pl1 pl2 l1 l2)))
     )
   )
   (vla-addExtrudedSolid Space reg haut 0.0)
   (mapcar '(lambda (x) (vl-catch-all-apply 'vla-delete (list x)))
    (list reg ent pl1 pl2 l1 l2)
    )
 )

 ;;==================================================================::

 (or (vlax-ldata-get "polysolid" "l")
     (vlax-ldata-put "polysolid" "l" 0.25)
 )
 (or (vlax-ldata-get "polysolid" "h")
     (vlax-ldata-put "polysolid" "h" 4.0)
 )
 (setq loop T)
 (while loop
   (initget 1 "Objet Largeur Hauteur")
   (setq pt
   (getpoint
     "\nSpécifiez le point de départ ou [Objet/Largeur/Hauteur]: "
   )
   )
   (cond
     ((listp pt)
      (setq larg (vlax-ldata-get "polysolid" "l")
     haut (vlax-ldata-get "polysolid" "h")
     loop nil
      )
      (make_pline pt larg haut)
     )
     ((= pt "Objet")
      (if (and
     (setq ent (car (entsel)))
     (or
       (member (cdr (assoc 0 (entget ent)))
	       '("ARC" "CIRCLE" "ELLIPSE" "LWPOLYLINE")
       )
       (and (= (cdr (assoc 0 (entget ent))) "SPLINE")
	    (= (logand 8 (cdr (assoc 70 (entget ent)))) 8)
	    ;(zerop (logand 1 (cdr (assoc 70 (entget ent)))))
       )
     )
   )
 (progn
   (setq larg (vlax-ldata-get "polysolid" "l")
	 haut (vlax-ldata-get "polysolid" "h")
	 loop nil
   )
   (poly2solid ent larg haut)
 )
 (prompt "\nEntité non valide.")
      )
     )
     ((= pt "Largeur")
      (if (setq
     larg (getdist (strcat
		     "\nSpécifiez la largeur 			     (rtos (vlax-ldata-get "polysolid" "l"))
		     ">: "
		   )
	  )
   )
 (vlax-ldata-put "polysolid" "l" larg)
      )
     )
     ((= pt "Hauteur")
      (if (setq haut (getdist (strcat
			 "\nSpécifiez la hauteur 				 (rtos (vlax-ldata-get "polysolid" "h"))
			 ">: "
		       )
	      )
   )
 (vlax-ldata-put "polysolid" "h" haut)
      )
     )
   )
 )
 (princ)
)

[Edité le 2/5/2007 par (gile)]

 

[Edité le 2/5/2007 par (gile)]

[lecrabe]

 

Hello Gilles

 

Je viens de tester ta magnifique routine sur AutoCAD 2006 et MAP 2006 :

 

- AutoCAD 2006 = OK

 

- MAP 3D 2006 = Saisie des paramètres du type Largeur, Hauteur, Parcours ou Objet = OK

MAIS génération d'une erreur : "Erreur Automation Entrée incorrecte"

 

Je pense que c'est lors du traitement pour transformer le parcours ou polyligne en Solid 3D !?

 

As tu une idée ?

 

Ou dois je modifier la routine pour tracer "un peu" le problème ?

(Mettre des ALERT par exemple)

 

Sugestion d'amélioration: Poser d'abord une question relative à la justification

Gauche, Droite, Axe central (par rapport à la largeur)

 

Encore merci, Le Decapode

 

 

[(gile)]

Cher décapode,

 

Merci d'avoir tester et surtout de donner un retour.

Pour l'erreur sur MAP 3D, je ne saurais dire. Au vu du message, elle se produit sûrement lors de la modélisation, dans la routine poly2solid. Pour tester, active les [surligneur](alert ...)[/surligneur] en supprimant les points-vigule. Si l'erreur ne se produit qu'avec des objets fermés, elle peut aussi provenir de la soustraction des régions.

 

Voici une nouvelle version qui reprend ta suggestion.

 

La justification est paramétrable, mais je ne peux plus utiliser le subterfuge de la largeur qui permettait de "prévisualiser" l'épaisseur du solide final.

 

EDIT : Plus d'erreur sur MAP 3D

 

EDIT 2 : version "finie" avec groupe d'annulation et gestion des erreurs.

 

;; POLYDSOLID -Gilles Chanteau- 03/05/07
;; Pour créer des polysolides avec les version antérieures à autoCAD 2007

(defun c:polysolid (/ erreur make_pline poly2solid AcDoc Space echo loop pt larg haut just ent)

 (vl-load-com)

 ;;===================================================;;

 (defun erreur	(msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "Erreur: " msg))
   )
   (vla-EndUndoMark
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
   (setvar "cmdecho" echo)
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 ;;===================================================;;

 (defun make_pline (pt larg haut just)
   (setvar "cmdecho" 0)
   (command "_.pline" pt)
   (setvar "cmdecho" 1)
   (while (/= 0 (getvar "cmdactive"))
     (command pause)
   )
   (command)
   (poly2solid (entlast) larg haut just)
 )

 ;;===================================================;;

 (defun poly2solid
 (ent larg haut just / pl1 pl2 l1 l2 reg)
   (setq ent (vlax-ename->vla-object ent))
   (cond
     ((= just "Gauche")
      (setq pl1 (vla-copy ent))
      (vla-offset ent larg)
      (setq pl2 (vlax-ename->vla-object (entlast)))
     )
     ((= just "Centre")
      (vla-offset ent (/ larg 2))
      (setq pl1 (vlax-ename->vla-object (entlast)))
      (vla-offset ent (/ larg -2))
      (setq pl2 (vlax-ename->vla-object (entlast)))
     )
     ((= just "Droite")
      (setq pl1 (vla-copy ent))
      (vla-offset ent (- larg))
      (setq pl2 (vlax-ename->vla-object (entlast)))
     )
   )
   (if	(or
  (and (member (vla-get-objectName ent)
	       '("AcDbPolyline" "AcDbSpline")
       )
       (= (vla-get-Closed ent) :vlax-true)
  )
  (= (vla-get-objectName ent) "AcDbCircle")
  (and (= (vla-get-objectName ent) "AcDbEllipse")
       (= (vla-get-StartAngle ent) 0.0)
       (= (vla-get-EndAngle ent) (* 2 pi))
  )
)
     (progn
(setq reg (vlax-invoke Space 'addRegion (list pl1 pl2)))
(if (	  (progn
    (vla-boolean (cadr reg) acSubtraction (car reg))
    (setq reg (cadr reg))
  )
  (progn
    (vla-boolean (car reg) acSubtraction (cadr reg))
    (setq reg (car reg))
  )
)
     )
     (setq l1	(vla-addLine
	  space
	  (vlax-3d-point (vlax-curve-getStartPoint pl1))
	  (vlax-3d-point (vlax-curve-getStartPoint pl2))
	)
    l2	(vla-addLine
	  space
	  (vlax-3d-point (vlax-curve-getEndPoint pl1))
	  (vlax-3d-point (vlax-curve-getEndPoint pl2))
	)
    reg	(car (vlax-invoke Space 'addRegion (list pl1 pl2 l1 l2)))
     )
   )
   (vla-addExtrudedSolid Space reg haut 0.0)
   (mapcar '(lambda (x) (vl-catch-all-apply 'vla-delete (list x)))
    (list reg pl1 pl2 l1 l2)
   )
   (or (zerop (getvar "DELOBJ")) (vla-delete ent))
 )

 ;;===================================================;;

 
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
echo (getvar "cmdecho")
m:err *error*
*error* erreur
 )
 (vla-StartUndoMark AcDoc)
 (or (vlax-ldata-get "polysolid" "l")
     (vlax-ldata-put "polysolid" "l" 0.25)
 )
 (or (vlax-ldata-get "polysolid" "h")
     (vlax-ldata-put "polysolid" "h" 4.0)
 )
 (or (vlax-ldata-get "polysolid" "j")
     (vlax-ldata-put "polysolid" "j" "Centre")
 )
 (princ (strcat "\nParamètres courants -Largeur: "
	 (rtos (vlax-ldata-get "polysolid" "l"))
	 " -Hauteur: "
	 (rtos (vlax-ldata-get "polysolid" "h"))
	 " -Justification: "
	 (vlax-ldata-get "polysolid" "j")
 )
 )
 (setq loop T)
 (while loop
   (initget "Objet Largeur Hauteur Justification")
   (setq pt
   (getpoint
     "\nSpécifiez le point de départ ou [Objet/Largeur/Hauteur/Justification] : "
   )
   )
   (cond
     ((or (null pt) (= pt "Objet"))
      (if (and
     (setq ent (car (entsel)))
     (or
       (member (cdr (assoc 0 (entget ent)))
	       '("ARC" "CIRCLE" "ELLIPSE" "LWPOLYLINE")
       )
       (and (= (cdr (assoc 0 (entget ent))) "SPLINE")
	    (= (logand 8 (cdr (assoc 70 (entget ent)))) 8)
       )
     )
   )
 (progn
   (setq larg (vlax-ldata-get "polysolid" "l")
	 haut (vlax-ldata-get "polysolid" "h")
	 just (vlax-ldata-get "polysolid" "j")
	 loop nil
   )
   (poly2solid ent larg haut just)
 )
 (prompt "\nEntité non valide.")
      )
     )
     ((listp pt)
      (setq larg (vlax-ldata-get "polysolid" "l")
     haut (vlax-ldata-get "polysolid" "h")
     just (vlax-ldata-get "polysolid" "j")
     loop nil
      )
      (make_pline pt larg haut just)
     )
     ((= pt "Largeur")
      (if (setq
     larg (getdist (strcat
		     "\nSpécifiez la largeur 			     (rtos (vlax-ldata-get "polysolid" "l"))
		     ">: "
		   )
	  )
   )
 (vlax-ldata-put "polysolid" "l" larg)
      )
     )
     ((= pt "Hauteur")
      (if (setq haut (getdist (strcat
			 "\nSpécifiez la hauteur 				 (rtos (vlax-ldata-get "polysolid" "h"))
			 ">: "
		       )
	      )
   )
 (vlax-ldata-put "polysolid" "h" haut)
      )
     )
     ((= pt "Justification")
      (initget "Gauche Centre Droite")
      (if (setq just
	  (getkword
	    (strcat
	      "\nEntrez la justification [Gauche/Centre/Droite] 		      (vlax-ldata-get "polysolid" "j")
	      ">: "
	    )
	  )
   )
 (vlax-ldata-put "polysolid" "j" just)
      )
     )
   )
 )
   (vla-EndUndoMark AcDoc)
   (setvar "cmdecho" echo)
   (setq *error* m:err
  m:err	nil
   )
 (princ)
)

[Edité le 3/5/2007 par (gile)][Edité le 3/5/2007 par (gile)]

 

[Edité le 3/5/2007 par (gile)]

[lecrabe]

 

Bon Matin Gilles

 

Je suis "FOU" mais maintenant avec cette nouvelle version de ta routine ,

il n'y a plus AUCUNE erreur sous MAP ! :exclam: :P

 

J'imagine que tu as corrigé / amélioré qq chose sans le savoir qui en fait plantait MAP !!! :o

 

Je te confirme son bon fonctionnement sous MAP 2004 / 2005 / 2006 :) :D :cool:

 

Mille mercis, Le Decapode "abasourdi mais heureux"

 

[(gile)]

C'est tant mieux :D

 

Merci pour le retour.

 

J'enlève du code ci-dessus les (alert ...) désormais inutiles.

[(gile)]

PolySolid est ajoutée aux LISP à télécharger sur cette page.

[zaza_du_67]

PolySolid est ajoutée aux LISP à télécharger sur cette page.