Hachures pour talus

[Crunchips]

Bonjour je débute en LISP et dans le cadre de mon stage je dois perfectionner un lisp que l'entreprise utilise régulièrement et qu'ils ont trouvé sur le net. Votre forum est très intéressant et j'y ai appris pas mal de choses et aujourd'hui j'en appelle à vous.

 

Ce lisp consiste en l'hachurage de talus. Je m'explique; leur talus possède un haut et un pied de talus représentés par deux lignes ou polylignes ou encore par une polyligne fermée.

 

Plusieurs améliorations me sont demandées : le Lisp se base sur le SCU par rapport à un point défini par l'utilisateur mais parfois les hachures sont inversées et partent dans le mauvais sens est il possible de définir que ces hachures doivent partir uniquement du côté désiré de la ligne choisie ?

 

Ensuite, il me faudrait déterminer la longueur entre le haut et le pied du talus et définir ainsi la taille de mes hachures mais je n'arrive pas à trouver comment faire pour déterminer la distance entre deux polylignes ou encore entre chacun des points de ces polylignes :casstet: Une des solutions que j'ai envisagé est de demander à l'utilisateur de déterminer chaque fois la longueur par getdist mais ce n'est pas vraiment pratique et il y'a surement beaucoup mieux à faire...

 

Voila je ne sais pas si j'ai été très clair mais merci à ceux qui vont se pencher là dessus.

 

Voici le LISP en question ceci est l'original aucune retouche n'y a été apporté :

 

;;; Talus.lsp
;;; Version 1.2
;;; Programme AutoLISP écrit par Maxence Delannoy (maxence.delannoy@wanadoo.fr)
;;; Dernière modification le 28.10.2000
;;; Objet: Dessine des peignes de talus.

(defun DESSINER_HACHURES (/ x LgEnt LgMotif)
 (setq
   x	    0
   LgEnt   (distance Pt1 Pt2)
   LgMotif (* Interv NbreIt)
 )
 (command "_UCS" "3" (trans Pt1 0 1) (trans Pt2 0 1) Pt3)
				; On oriente le SCU par rapport à la ligne       
 (while (< x LgEnt)
   (if	(= TypTal "T")
     (if (= (rem x LgMotif) 0)
(command "_LINE" (list x 0) (list x LgGT) "") ; Grand trait
(command "_LINE" (list x 0) (list x LgPT) "") ; Petit trait
     )
     (command "_INSERT" NomBloc (list x 0) "" "" "")
   )
   (setq x (+ x Interv))
 )
 (command "_UCS" "_P")
)

(defun c:TALUS (/	AncBMd	AncCmd	AncIco	AncOsm	Interv	LgGT
	LgMotif	LgPT	LstEnt	NbreIt	TypTal	NomEnt	Pt1
	Pt2	Pt3	r	x	NomBloc	LgEnt	TypEnt
	i	LstVx
       )

 ;; *** Sauvegarde de l'état initial ***
 (setq
   AncBMd (getvar "BLIPMODE")
   AncCmd (getvar "CMDECHO")
   AncOsm (getvar "OSMODE")
   AncIco (getvar "UCSICON")
 )

 ;; *** Paramétrage des variables systèmes ***
 (setvar "BLIPMODE" 0)
 (setvar "CMDECHO" 0)
 (setvar "OSMODE" 0)
 (setvar "UCSICON" 0)

 ;; *** Chargement des paramètres programmes ***
 (if (setq r (getcfg "AppData/Talus/LgGT"))
   (setq LgGT (atof r))
   (setq LgGT 5)
 )
 (if (setq r (getcfg "AppData/Talus/LgPT"))
   (setq LgPT (atof r))
   (setq LgPT 2)
 )
 (if (setq r (getcfg "AppData/Talus/Interv"))
   (setq Interv (atof r))
   (setq Interv 2)
 )
 (if (setq r (getcfg "AppData/Talus/NbreIt"))
   (setq NbreIt (atof r))
   (setq NbreIt 4)
 )
 (if (setq r (getcfg "AppData/Talus/TypTal"))
   (setq TypTal r)
   (setq TypTal "T")
 )
 (if (setq r (getcfg "AppData/Talus/NomBloc"))
   (setq NomBloc r)
   (setq NomBloc "Talus")
 )

 (initget "I C S")
 (setq	r
 (entsel
   "\n/Changer les paramètres/Sortir: "
 )
 )
 (while (and r (/= r "S"))
   (if	(= r "C")

     ;; *** Changement des paramètres ***
     (progn
(initget "T B")
(if (= TypTal "T")
  (if (setq r (getkword "\nType de talus /Bloc : "))
    (setq TypTal r)
  )
  (if (setq r (getkword "\nType de talus Traits/ : "))
    (setq TypTal r)
    (setq TypTal "B")
  )
)
(if (= TypTal "B")
  (progn
    (if	(/= ""
	    (setq r
		   (getstring (strcat "\nNom du bloc <" NomBloc "> : ")
		   )
	    )
	)
      (setq NomBloc r)
    )
    (if	(setq r
	       (getreal
		 (strcat "\nIntervalle entre deux blocs consécutifs <"
			 (rtos Interv)
			 ">: "
		 )
	       )
	)
      (setq Interv r)
    )
  )
  (progn
    (if	(setq r	(getreal (strcat "\nLongueur du grand trait <"
				 (rtos LgGT)
				 ">: "
			 )
		)
	)
      (setq LgGT r)
    )
    (if	(setq r	(getreal (strcat "\nLongueur du petit trait <"
				 (rtos LgPT)
				 ">: "
			 )
		)
	)
      (setq LgPT r)
    )
    (if	(setq
	  r (getreal
	      (strcat
		"\nIntervalle entre deux traits consécutifs <"
		(rtos Interv)
		">: "
	      )
	    )
	)
      (setq Interv r)
    )
    (if	(setq r
	       (getreal
		 (strcat
		   "\nNombre d'intervalle entre deux grands traits <"
		   (rtos NbreIt)
		   ">: "
		 )
	       )
	)
      (setq NbreIt r)
    )
  )
)
     )

     ;; *** Dessin des motifs ***
     (progn
(command "_UNDO" "_BE")		; On groupe les opérations d'annulation  
(setq
  LstEnt (entget (setq NomEnt (car r)))
  TypEnt (cdr (assoc 0 LstEnt))
  Pt3	 (getpoint "\nIndiquez le côté des hachures: ")
)
(cond

  ;; *** On a sélectionné une ligne ***
  ((= TypEnt "LINE")
   (setq
     Pt1 (cdr (assoc 10 LstEnt))
     Pt2 (cdr (assoc 11 LstEnt))
   )
   (DESSINER_HACHURES)
  )

  ;; *** On a sélectionné une polyligne optimisée ***
  ((= TypEnt "LWPOLYLINE")

   ;; *** On crée une liste avec les différents vertex de la polyligne ***
   (setq
     LstVx nil
     i 0
   )
   (while (< i (length LstEnt))
     (if (= (car (nth i LstEnt)) 10)
       (setq LstVx (cons (cdr (nth i LstEnt)) LstVx))
     )
     (setq i (1+ i))
   )

   ;; *** On trace les hachures pour chaque segment ***
   (setq
     NbreSeg (1- (length LstVx)); Nbre de segments = Nbre de vertex - 1
     i	     0
   )
   (while (< i NbreSeg)
     (setq
       Pt1 (nth i LstVx)
       Pt2 (nth (1+ i) LstVx)
       i   (1+ i)
     )
     (DESSINER_HACHURES)
   )

   ;; *** Cas ou la polyligne est fermée ***
   (if (/= (boole 1 (cdr (assoc 70 LstEnt)) 1) 0)
     (progn
       (setq
	 Pt1 (nth 0 LstVx)
	 Pt2 (last LstVx)
       )
       (DESSINER_HACHURES)
     )
   )
  )
)
(command "_UNDO" "_E")
     )
   )
   (initget "I C S")
   (setq r
   (entsel
     "\n/Changer les paramètres/Sortir: "
   )
   )
 )

 ;; *** sauvegarde des données programmes ***
 (setcfg "AppData/Talus/LgGT" (rtos LgGT))
 (setcfg "AppData/Talus/LgPT" (rtos LgPT))
 (setcfg "AppData/Talus/Interv" (rtos Interv))
 (setcfg "AppData/Talus/NbreIt" (rtos NbreIt))
 (setcfg "AppData/Talus/TypTal" TypTal)
 (setcfg "AppData/Talus/NomBloc" NomBloc)

 ;; *** Restauration de l'état initial ***
 (setvar "BLIPMODE" AncBMd)
 (setvar "CMDECHO" AncCmd)
 (setvar "OSMODE" AncOsm)
 (setvar "UCSICON" AncIco)

 (princ)
)

(prompt
 "M.D.D. - Talus.lsp chargé. Tapez TALUS pour dessiner des peignes de talus."
)
(princ)

 

[edité par (gile) : ajout des balise bbcodes]

[bonuscad]

Bonjour,

 

Sur ma page , tu peux trouver 3 fichiers (talus.lsp talus.dcl talus.slb).

 

Si tu places ces 3 fichier dans un dossier qui est déclaré (ou en déclarer un nouveau) dans les chemins de recherche, tu pourras dessiner en t'appuyant sur toutes sorte d'entités 2D (polyligne, spline, ligne, cercle, arc, ellipse ...)

 

Cette routine est ancienne, mais fonctionne toujours. Je me suis promis de la faire évoluer (talus 3D), j'ai commencé, mais je me heurte à des difficultés de projection...