Aller au contenu

Messages recommandés

Posté(e)

voilà un programme qui n'est pas de moi bien sur mais bien utile

 

 ;
; CH_EPL.LSP - gratuiciel
; Version 1.4 pour  Autocad 2002 ou superieur
; Revision du $Date: 28/01/04 7:31 $
; Ecrit par Didier Lourdelle
;
; Mise à jour en 1.2 le 18/08/1998 par Didier LOURDELLE tient compte des LWPOLYLINE
; Mise à jour en 1.3 le 30/09/1998 par Pierre-Marie BOITEL  tient compte des cercles en les transforment en polyligne
; Mise à jour en 1.4 le 28/01/2004 par Didier LOURDELLE modification de l'epaisseur avec la commande polyligne et l'option multiple pour un traitement plus rapide.
; 
;   $Workfile: ch_epl1-4.lsp $
;   $Date: 28/01/04 7:31 $
;   $Revision: 5 $
;
; Test le 2004/01/28
;
; AutoCAD 2005 us ok
; AutoCAD 2004 fr ok
; AutoCAD 2002 fr ok
;
;http://www.didier-lourdelle.fr/
;
;E-mail :dlourdelle@didier-lourdelle.fr
;
;Vous êtes libres de diffuser ce gratuiciel 
;
;	**************************
;	***c'est même conseillé***
;	**************************
;
;Vous êtes libres de diffuser ce gratuiciel 
;
;
; Modification d'epaisseur de line, polyligne, cercle anneaux en une seule manipulation
;
(defun dl_ini_mem_ch_epl ()
(setq cmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq osmode (getvar "osmode"))
(setvar "osmode" 0)
(command "_undo" "_m")
);defun dl_ini_mem_break

(defun dl_ini_rest_ch_epl ( / )
(setvar "cmdecho" cmde)
(setvar "osmode" osmode)
 	(setq cmde nil osmode nil)
);defun dl_ini_rest_break
;;
;;
;;
(defun dl_select1_ch_epl ( / js i lent ent typent rayon centre calque flagLigneArc)
(prompt "\nEntrez la nouvelle epaisseur ") (princ (getvar "PLINEWID")) (prompt " :")
(setq ep (getreal ))
(if ep
	(setvar "PLINEWID" ep)
	(setq ep (getvar "PLINEWID"))
)
(prompt "\nChoisissez vos polylignes,arc,anneaux,ellispses,lignes,cercle :")
(setq js (ssget))
(setq i 0)
 	(prompt "\nConvertion des cercles en ARC")
(repeat (sslength js)
	(setq ent (ssname js i))
	(setq lent (entget ent))
	(setq typent (cdr (assoc 0 lent)))
	(if 	(null
			(or
				(= typent "ARC")
				(= typent "LINE")
				(= typent "POLYLINE")
				(= typent "LWPOLYLINE")
				(= typent "CIRCLE")
				
			);or
		);null
		(setq i (1+ i))
		(cond
			((= typent "ARC")
				(progn
					(setq flagLigneArc T)
					(setq i (1+ i))
				)
			)
			((= typent "LINE")
				(progn
					(setq flagLigneArc T)
					(setq i (1+ i))
				)
			)
			((= typent "CIRCLE")
				(progn
					(setq rayon (cdr (assoc '40 lent)))
					(setq centre (cdr (assoc '10 lent)))
					(setq calque (cdr (assoc '8 lent)))
					(entdel ent)
					(command "_pline" 
						(list 
						 (- (car centre) rayon) 
						 (cadr centre)
						 (caddr centre)
						)
						"_a" "_r" rayon "_a" "180" "0"
						"_cl"
					)
					(command "_change" (entlast) "" "_pr" "_la" calque "")
					(setq i (1+ i))
				)
			)
			
		);cond
	);if
);repeat
 	(if (= flagLigneArc T)
 		(command "_pedit" "_m" js "" "_y" "_w" ep "")
   		(command "_pedit" "_m" js "" "_w" ep "")	  
)

)
;;
;;
;;
(Defun c:CH_EPL ( / )

;;Dans un SCU particulier le cercle s'efface,
;;Se place provisoirement dans le SCG -	                     
          (command "cmdecho" 0)           
          (command "scu" "ef" "CH_EPL");efface le SCU particulier CH_EPL si il existe déja dans le dessin
          (command "scu" "s" "CH_EPL" );sauve le SCU particulier en CH_EPL
          (command "scu" "g")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;           
(dl_ini_mem_ch_epl)
(dl_select1_ch_epl)
(dl_ini_rest_ch_epl)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Revient dans le SCU précédent                       
          (command "scu" "R" "CH_EPL" ) 
          (command "cmdecho" 1) 
 	(princ)
)

 

A+

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité