Multispline

[LUDWIG]

Bonjour,

 

Sauriez-vous s'il existe un moyen simple et rapide pour créer des splines parallèles. En gros, un compromis entre la spline et la multiligne,pour représenter des gaines souples.

 

Actuellement, je trace une spline (axe de la gaine) que je décale de part et d'autre du rayon de ma gaine.

 

Merci d'avance pour vos contributions !

[(gile)]

Salut,

 

Un petit truc vite fait :

 

(defun c:mspline (/ elast width spl)
 (vl-load-com)
 (or *msplinewidth* (setq *msplinewidth* 10.0))
 (setq elast (entlast))
 (initget 6)
 (if (setq
width (getdist (strcat "\nLargeur : "))
     )
   (setq *msplinewidth* width)
   (setq width *msplinewidth*)
 )
 (vl-cmdf "_.spline")
 (while (/= 0 (getvar 'cmdactive))
   (vl-cmdf pause)
 )
 (if (setq spl (if elast
	(entnext elast)
	(entlast)
      )
     )
   (progn
     (setq spl (vlax-ename->vla-object spl))
     (vla-offset spl (/ width 2))
     (vla-Offset spl (/ width -2))
     (vla-delete spl)
   )
 )
 (princ)
)

[nicoping28]

Merci (gile),

pour ce précieux lisp;

As tu déjà fait le même pour une polyligne (standard) ?

 

Nico.

[(gile)]

As tu déjà fait le même pour une polyligne (standard) ?

 

C'est possible, comme beaucoup d'autres. Si tu fais une recherche tu devrais en trouver plusieurs plus ou moins sophistiqués.

 

Sinon, il suffit de remplacer tous les "spl" par "pl" dans la routine ci-dessus :

 

(defun c:mpline (/ elast width pl)
 (vl-load-com)
 (or *mplinewidth* (setq *mplinewidth* 10.0))
 (setq elast (entlast))
 (initget 6)
 (if (setq
width (getdist (strcat "\nLargeur : "))
     )
   (setq *mplinewidth* width)
   (setq width *mplinewidth*)
 )
 (vl-cmdf "_.pline")
 (while (/= 0 (getvar 'cmdactive))
   (vl-cmdf pause)
 )
 (if (setq pl (if elast
	(entnext elast)
	(entlast)
      )
     )
   (progn
     (setq pl (vlax-ename->vla-object pl))
     (vla-offset pl (/ width 2))
     (vla-Offset pl (/ width -2))
     (vla-delete pl)
   )
 )
 (princ)
)

[LUDWIG]

[surligneur] Génial ![/surligneur]

 

Merci (gile)

 

 

J'ai supprimé

(vla-delete spl)

car je garde l'axe

 

Je vais me faire un bouton sur firefox pour coller automatiquement le texte "merci (gile)" !

[(gile)]

Puisque ça semble plaire, les deux commandes un peu plus évoluées (lire les commentaires au début du code)

 

EDIT 1 : modification des invites

EDIT 2 : amélioration de la gestion des erreurs

 

;;; MPLINE et MSPLINE -Gilles Chanteau- 05/06/09
;;; Définit les commandes MPLINE et MSPLINE
;;; Ces commandes permettent de créer des splines ou polylignes parallèles
;;; Les objets peuvent être dessinés "à la volée" ou crées à partir d'objets source
;;; du même type (option Objet)
;;; Les objets sont créés sur le calque courant
;;; Des paramètres modifiables sont conservés dans le dessin :
;;; - Largeur : largeur totale (défaut 1.0)
;;; - Justification : position de l'objet source par rapport au décalages (défaut Milieu)
;;;f - Effacer : détermine si l'objet source est effacé ou non (defaut Oui)

(defun gc:multipline (typ      /	*error*	 offsetpline
	      make_mpline	AcDoc	 Space	  echo
	      dict     loop	pt	 larg	  del
	      just     ent el
	     )
 (vl-load-com)

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

 (defun *error* (msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "Erreur: " msg))
   )
   (and el (entdel el))
   (vla-EndUndoMark
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
   (setvar "cmdecho" echo)
   (princ)
 )

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

 (defun offsetpline (typ ent larg just / pl1 pl2)
   (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)))
     )
   )
   (vla-put-Layer pl1 (getvar "CLAYER"))
   (vla-put-Layer pl2 (getvar "CLAYER"))
   (and (= (vlax-ldata-get (strcat "multi" typ) "d") "Oui")
 (vla-delete ent)
   )
 )

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

 (defun make_mpline (typ pt larg just / elast pl)
   (setq el (entmakex '((0 . "CIRCLE") (10 0. 0. 0.) (40 . 1e-9))))
   (setvar "cmdecho" 0)
   (if	(= typ "LWPOLYLINE")
     (vl-cmdf "_.pline" pt)
     (vl-cmdf "_.spline" pt)
   )
   (setvar "cmdecho" 1)
   (while (/= 0 (getvar "cmdactive"))
     (vl-cmdf pause)
   )
   (setq pl (entnext el))
   (entdel el)
   (setq el nil)
   (if	pl
     (offsetpline typ pl larg just)
   )
 )

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

 (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")
dict  (strcat "multi" typ)
 )
 (vla-StartUndoMark AcDoc)
 (or (vlax-ldata-get dict "l")
     (vlax-ldata-put dict "l" 1.0)
 )
 (or (vlax-ldata-get dict "j")
     (vlax-ldata-put dict "j" "Centre")
 )
 (or (vlax-ldata-get dict "d")
     (vlax-ldata-put dict "d" "Oui")
 )
 (princ (strcat "\nParamètres courants -Largeur: "
	 (rtos (vlax-ldata-get dict "l"))
	 " -Justification: "
	 (vlax-ldata-get dict "j")
	 " - Effacer source: "
	 (vlax-ldata-get dict "d")
 )
 )
 (setq loop T)
 (while loop
   (initget "Objet Largeur Justification Effacer")
   (setq pt
   (getpoint
     "\nSpécifiez le point de départ ou [Objet/Largeur/Justification/Effacer source] : "
   )
   )
   (cond
     ((or (null pt) (= pt "Objet"))
      (if (and
     (setq ent (car (entsel)))
     (= (cdr (assoc 0 (entget ent))) typ)
   )
 (progn
   (setq larg (vlax-ldata-get dict "l")
	 just (vlax-ldata-get dict "j")
	 loop nil
   )
   (offsetpline typ ent larg just)
 )
 (prompt "\nEntité non valide.")
      )
     )
     ((listp pt)
      (setq larg (vlax-ldata-get dict "l")
     just (vlax-ldata-get dict "j")
     loop nil
      )
      (make_mpline typ pt larg just)
     )
     ((= pt "Largeur")
      (if (setq
     larg (getdist (strcat
		     "\nSpécifiez la largeur 			     (rtos (vlax-ldata-get dict "l"))
		     ">: "
		   )
	  )
   )
 (vlax-ldata-put dict "l" larg)
      )
     )
     ((= pt "Justification")
      (initget "Gauche Centre Droite")
      (if (setq just
	  (getkword
	    (strcat
	      "\nEntrez la justification [Gauche/Centre/Droite] 		      (vlax-ldata-get dict "j")
	      ">: "
	    )
	  )
   )
 (vlax-ldata-put dict "j" just)
      )
     )
     ((= pt "Effacer")
      (initget "Oui Non")
      (if (setq del
	  (getkword
	    (strcat
	      "\nEffacer la polyligne source [Oui/Non] 		      (vlax-ldata-get dict "d")
	      ">: "
	    )
	  )
   )
 (vlax-ldata-put dict "d" del)
      )
     )
   )
 )
 (vla-EndUndoMark AcDoc)
 (setvar "cmdecho" echo)
 (princ)
)

;;===================================================;;
;;==================== COMMANDES ====================;;
;;===================================================;;

(defun c:mpline	()
 (gc:multipline "LWPOLYLINE")
 (princ)
)

(defun c:mspline ()
 (gc:multipline "SPLINE")
 (princ)
)

[usegomme]

Bonjour

Merci (gile) pour ces nouvelles commandes sympa. et instructives question écriture .

Tu es toujours aussi impressionnant et peut être même de plus en plus.

[(gile)]

Merci usegomme, en fait j'ai adapté ce que j'avais fait pour PolySolid.

[LUDWIG]

encore mieux !

[(gile)]

Merci

 

Petite modification du code : amélioration de la gestion des erreurs.