Routine lisp pour autocad pour préparation d'implantation en topographie

Télécharger le projet
Commenter

Description

Ce programme peut etre utilisé librement et gratuitement sous votre responsabilité et etre distribué gratuitement dans son intégralité.

Auteur richardtoubin@live.fr

Réalisé par Richard.TOUBIN E.J.L. GRENOBLE le 03/08/1998.
Modification pour ignorer les accrochages aux objets permanents le, 11/06/98.
Modification pour le choix du 1er numéro le 15/10/99.
Modification pour la prise en compte de réel comme numéros avec un pas choisi réel le 24/10/99.
Modification pour la couleur rouge des N° le 24/10/99.

UTILITE DE "IMPLANTE.LSP":
-------------------------

Le programme créé un jeu de tous les points contenus dans un LAYER choisi.
Puis il les numérote (dans l'ordre de conception) dans un nouveau LAYER.
Il indique également la cote Z des points dans un nouveau LAYER.
Parallèlement il compose un fichier listing de points au format TXT avec une
proposition d'extention .NXYZ.
Vous pouvez alors ouvrir ce fichier par exemple sur EXCEL (séparateur ESPACE).

MODE D'EMPLOI SUR AUTOCAD R14:
-----------------------------
Créez un répertoir LSP (par exemple) dans le répertoire d'AUTOCAD.
Copiez le fichier IMPLANTE.LSP dans ce répertoire.
Ouvrir AUTOCAD.
  • Dans le menu Outils :

--------> Préférences ...
--------> dans l'onglet fichiers.
--------> double cliquer sur "Chemin de recherche de fichiers de support.
--------> Ajouter...
--------> Parcourir...
--------> Allez dans le répertoire où se trouve implante.lst (LSP).
--------> OK.
--------> OK.
Cette manipulation n'est a faire qu'une fois.Lorsque AUTOCAD connait le chemin d'accès aux
fichiers LISP (*.LSP),il le garde en mémoire.

Puis à chaque fois que vous voulez utiliser IMPLANTE.LSP,dans une nouvelle session AUTOCAD,
il faudra charger ce fichier de la manière suivante.
  • Dans le menu Outils :

--------> Charger une application.
--------> Cliquez sur IMPLANTE.LSP.
--------> Cliquez sur Charger.

Désormais le fichier IMPLANTE.LSP est en mémoire dans AUTOCAD.
Pour l'appeler tapez "IMPLANTE" ou "IMP" puis Entrée.
Suivre les indications en bas de l'écran.
|;

Source / Exemple : 


;|IMPLANTE.LSP (version 1.0)

Ce programme peut etre utilisé librement et gratuitement sous votre responsabilité et etre distribué gratuitement dans son intégralité.

Auteur richardtoubin@live.fr

Réalisé par Richard.TOUBIN E.J.L. GRENOBLE le 03/08/1998.
Modification pour ignorer les accrochages aux objets permanents le, 11/06/98.
Modification pour le choix du 1er numéro le 15/10/99.
Modification pour la prise en compte de réel comme numéros avec un pas choisi réel le 24/10/99.
Modification pour la couleur rouge des N° le 24/10/99.

UTILITE DE "IMPLANTE.LSP":
-------------------------

Le programme créé un jeu de tous les points contenus dans un LAYER choisi.
Puis il les numérote (dans l'ordre de conception) dans un nouveau LAYER.
Il indique également la cote Z des points dans un nouveau LAYER.
Parallèlement il compose un fichier listing de points au format TXT avec une
proposition d'extention .NXYZ.
Vous pouvez alors ouvrir ce fichier par exemple sur EXCEL (séparateur ESPACE).

MODE D'EMPLOI SUR AUTOCAD R14:
-----------------------------
Créez un répertoir LSP (par exemple) dans le répertoire d'AUTOCAD.
Copiez le fichier IMPLANTE.LSP dans ce répertoire.
Ouvrir AUTOCAD.


    	
  •  Dans le menu Outils :

		   --------> Préférences ...
		   --------> dans l'onglet fichiers.
		   --------> double cliquer sur "Chemin de recherche de fichiers de support.
		   --------> Ajouter...
		   --------> Parcourir...
		   --------> Allez dans le répertoire où se trouve implante.lst (LSP).
		   --------> OK.
		   --------> OK.
Cette manipulation n'est a faire qu'une fois.Lorsque AUTOCAD connait le chemin d'accès aux
fichiers LISP (*.LSP),il le garde en mémoire.

Puis à chaque fois que vous voulez utiliser IMPLANTE.LSP,dans une nouvelle session AUTOCAD,
il faudra charger ce fichier de la manière suivante.


    	
  •  Dans le menu Outils :

		   --------> Charger une application.
		   --------> Cliquez sur IMPLANTE.LSP.
		   --------> Cliquez sur Charger.

Désormais le fichier IMPLANTE.LSP est en mémoire dans AUTOCAD.
Pour l'appeler tapez "IMPLANTE" ou "IMP" puis Entrée.
Suivre les indications en bas de l'écran.
|;

(defun IMPLANTE_er (s)
				 ; If an error (such as CTRL-C) occurs
				; while this command is active...
	(if (/= s "Function cancelled.")
		(if (= s "quit / exit abort")
			(princ)
			(princ (strcat "\nFonction annulée..."))
		)
		(princ)
	)
	(IMPLANTE_rme) 
	(princ)
)

(defun IMPLANTE_lcm ()
	(command "_.UNDO" "D")
	(setq IMPLANTE_ver "1.0")
	(if *error*				 ; Set our new error handler
		(setq IMPLANTE_oe *error* *error* IMPLANTE_er) 
		(setq *error* IMPLANTE_er) 
	)
	(setq flag_textsize (getvar "TEXTSIZE")
	flag_cmdecho (getvar "CMDECHO")
	flag_clayer (getvar "CLAYER"))
	
	(princ (strcat "\n\nIMPLANTE, Version 2.4, TOUBIN Richard EJL GRENOBLE Octobre 1999.\n"))
	
	(setvar "CMDECHO" 0)
	(command "_.UCS" "_W")
	(princ)

;(setq t (startapp "d:\\topo\\7\\implante.exe"))
;(if (< t 0) (alert "Ce logiciel est protégé par copyrights     CLEF de PROTECTION ABSCENTE"))
;(if (< t 0) (exit))
)

(defun IMPLANTE_rme ()
	(if IMPLANTE_oe			; If an old error routine exists
			(setq *error* IMPLANTE_oe)	 ; then, reset it 
	)
	(setvar "TEXTSIZE" flag_textsize)
	(setvar "CLAYER" flag_clayer)
	(if open_fichier (setq open_fichier (close open_fichier)))
	(setq IMPLANTE_ver nil IMPLANTE_oe nil IMPLANTE_er nil IMPLANTE_sel nil IMPLANTE_ent nil flag_textsize nil flag_clayer nil)
	(command "_.UNDO" "F")
	(setvar "CMDECHO" flag_cmdecho)
	(setq flag_cmdecho nil)
	(princ)
)

(defun IMPLANTE_pro ()

	(setq implante_test T)
	(while implante_test
		(while (not (setq implante_sel (entsel "\nChoix d'un point d'implantation: "))))
		(setq implante_ent (car implante_sel))
		(if (= (cdr (assoc 0 (entget implante_ent))) "POINT") (setq implante_test nil) (princ "\nL'objet sélectionné n'est pas un point. "))
	)
	(setq implante_style_ht (getdist (strcat "\nHauteur des numéros ( 0.32 pour du 1/200° )<" (rtos flag_textsize) ">: ")))
	(if (not implante_style_ht) (setq implante_style_ht flag_textsize)) 
	(setq implante_num_ori (getangle (strcat "\nAngle de rotation des numéros ( degrés sens inverse horaire 90 conseillé ) <" (angtos 0. (getvar "AUNITS") (getvar "AUPREC")) ">: ")))
	(if (not implante_num_ori) (setq implante_num_ori (atof (angtos 0. (getvar "AUNITS") (getvar "AUPREC")))))
	(setq implante_num_ori (angtos implante_num_ori (getvar "AUNITS") (getvar "AUPREC")))
	(setq implante_ngf_ori (rtos (- (atof implante_num_ori) (atof (angtos (/ pi 2) (getvar "AUNITS") (getvar "AUPREC"))))))
	(setq implante_ass_0 (assoc 0 (entget implante_ent)))
	(setq implante_ass_8 (assoc 8 (entget implante_ent)))
	(setq implante_ass_8_num (strcat (cdr implante_ass_8) "_num"))
	(setq implante_ass_8_ngf (strcat (cdr implante_ass_8) "_ngf"))
	(setq implante_liste_filtres ())
	(setq implante_liste_filtres (cons implante_ass_8 implante_liste_filtres))
	(setq implante_liste_filtres (cons implante_ass_0 implante_liste_filtres))
	(setq implante_ss (ssget "X" implante_liste_filtres))
	(setq implante_n (sslength implante_ss))
	(setq ct (- implante_n 1))

	(setq ct_num (getreal "\nNuméros du 1ér POINT < 1 >: "))
	(if (not ct_num) (setq ct_num 1))
	

	(setq pas (getreal "\nValeur du PAS < 1 >: "))
	(if (not pas) (setq pas 1))
	

 
	(defini_fichier "w")

	(repeat implante_n
		(setq implante_ent (ssname implante_ss ct))
		(setq implante_ass_10 (cdr (assoc 10 (entget implante_ent))))
		(setq implante_ass_40 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
		(setq implante_x (nth 0 implante_ass_10))
		(setq implante_y (nth 1 implante_ass_10))
		(setq implante_z (nth 2 implante_ass_10))
		
		(setq dimz (getvar "dimzin"));;;Pour l'affichage des valeurs sans les zéros
 		
		
		(if (= implante_ass_40 0)
			(progn
				(command "_.LAYER" "_MAKE" implante_ass_8_num "")
				(setvar "dimzin" 8);;;Pour l'affichage des valeurs sans les zéros
				(setq numero (rtos ct_num))
				(command "_.TEXT" implante_ass_10 implante_style_ht implante_num_ori numero)

				(command "_.LAYER" "_MAKE" implante_ass_8_ngf "")
				(setvar "dimzin" dimz);;;on repasse la valeur de la variable "dimzin" à ce quelle était.
				(command "_.TEXT" implante_ass_10 implante_style_ht implante_ngf_ori (rtos implante_z (getvar "LUNITS") (getvar "LUPREC")))
			)
			(progn
				(command "_.LAYER" "_MAKE" implante_ass_8_num "")
				(setvar "dimzin" 8);;;Pour l'affichage des valeurs sans les zéros
				(setq numero (rtos ct_num))
				(command "_.TEXT" implante_ass_10 implante_num_ori numero)

				(command "_.LAYER" "_MAKE" implante_ass_8_ngf "")
				(setvar "dimzin" dimz);;;on repasse la valeur de la variable "dimzin" à ce quelle était.
				(command "_.TEXT" implante_ass_10 implante_ngf_ori (rtos implante_z (getvar "LUNITS") (getvar "LUPREC")))
			)
		)
		(write-line (strcat numero "  " (rtos implante_x ) " " (rtos implante_y ) " " (rtos implante_z )) open_fichier)
		(setq ct (- ct 1))
		(setq ct_num (+ ct_num pas))
		(setvar "dimzin" dimz);;;on repasse la valeur de la variable "dimzin" a ce quelle était.
	)
	(princ)

(command "_layer" "co" 1 implante_ass_8_num <entrée>) ;Pour couleur du calque des N° en rouge .
)

;**********DEFINITION DE LECTURE OU ECRITURE DE FICHIER**************

(defun defini_fichier (def)
	(setq r_or_w def)
	(setq fichier (creat_fich "Linsting de points à créer" "" "NXYZ" 11))
	(if (= r_or_w "w")
		(setq open_fichier (open fichier "w"))
		(setq open_fichier (open fichier "r"))
	)
	(princ)
)

;******************CREATION DE FICHIER PAR CASE DE DIALOGUE**************

(defun creat_fich (titre default ext drapeaux)
	(setq titre titre default default ext ext drapeaux drapeaux)
	(if (null creat_fich_fix)
		(setq creat_fich_fix (getvar "DWGPREFIX"))
		(while (not (wcmatch creat_fich_fix "*\\"))
			(setq creat_fich_fix (substr creat_fich_fix 1 (- (strlen creat_fich_fix) 1)))
		)
	)
	(if (null ext)
		(if (null creat_fich_ext)
			(setq creat_fich_ext "*")
		)
		(setq creat_fich_ext ext)
	)
	(if (null default)
		(setq fichier (if (or (= fichier "") (= fichier nil)) (princ "") fichier))
		(setq fichier default)
	)
	(if (= nil (setq fichier(getfiled titre fichier creat_fich_ext drapeaux)))
		(exit)
			(setq creat_fich_ext 
				(strcase (substr fichier (- (strlen creat_fich_fix) 2) (strlen fichier)) T)
			)
	)
	fichier
)

(defun IMPLANTE_init ()
	(IMPLANTE_lcm)
	(IMPLANTE_pro)
	(IMPLANTE_rme)
	(princ)
)

(defun C:IMPLANTE () (IMPLANTE_init) (princ))
(defun C:IMP () (IMPLANTE_init) (princ))

(princ "\n\tC:CONCU PAR richardtoubin@live.fr              IMPLANTE chargé. Pour exécuter, taper : IMP ou IMPLANTE.")
(princ)

Conclusion :


Du temp à gagner
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_richardt)