[Résolu] Routine qui marchait qui marche plus

[grand_sapin]

Bonjour à tous,

 

Un collègue a réalisé cette routine a une certaine époque, il ne comprend pas pourquoi elle ne fonctionne plus.

Pour résumer, elle est censée :

- Analyser tous les calques commençant par « A_01_1C*»,

- Créer un calque « A_01_1H_xoxoxo»

- Hachurer en choppant les polylignes présentes sur « A_01_1C_xoxoxo »

- Vérifier que les polylignes sont fermées

- Donner toutes les surfaces dans un document texte

 

;;;Date : 21 octobre 2009
;;;Auteur : Olivier Mayol
;;;Fonction :
;;;creelist génération d'une liste de calque
;;;lamba création d'une liste de calque hachure à partir
;;;d'une liste de calque contour
;;;Hachurage des polylignes sur le calque Hachure
;;;erasEnt-js Effaçage des polylignes existantes sur les Hachures


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun erasEnt-JS(SS-erase / nomEnt)
(while (/= (sslength SS-erase) 0)
(setq nomEnt(ssname SS-erase 0))
(entdel nomEnt)
(ssdel nomEnt SS-erase)
)
)  	
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun surface ()

( setq surf ( + surf   (getvar "AREA") ) )



)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun fermepoly ( )
		
  		
 	(if (OR (= (cdr(assoc 70(entget(ssname ssObjet ID-Ent)))) 128)	(= (cdr(assoc 70(entget(ssname ssObjet ID-Ent)))) 0)  )  ;
 		
 		(progn
 		(command "Pedit" (ssname ssObjet ID-Ent) "LA" "1" "C" "");change epaisseur et clos la polyligne
 		(command "_Change" (ssname ssObjet ID-Ent) "" "P" "CO" "192" "");change couleur
	(setq ind ( 1+ ind))
	(setq testAlert  (strcat (itoa ind)   "   polyligne(s) était ouverte .\n Elle(s) a été close et signalée par la couleur 192 et largeur 1."))
	
 		)   		
 	)
 	

)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;(defun G-ERROR (Msg)
;;;  
;;;  (setq *error* SavErr)
;;;  (princ Msg)
;;;  (princ)
;;;  (command "cmdecho" 1) 
;;;  (command "_.undo" "_end")
;;;  ;(tblnext "LAYER" T)
;;; ; (setvar "CLAYER" anccalque)
;;;)	
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun hachures ( CalqueActif / )

(cond

  (( = CalqueActif "A_01_1H_VOIRIE" ) (setq Type-Hach_ "DOTS" 		Ech_  0.5  ))
  (( = CalqueActif "A_01_1H_PK" ) (setq Type-Hach_ "ANSI31" 		Ech_  1  ))
  (( = CalqueActif "A_01_1H_ACCES" ) (setq Type-Hach_ "DOLMIT" Ech_  0.1  ))
  (( = CalqueActif "A_01_1H_TROTT" ) (setq Type-Hach_ "ANSI37" Ech_  1.5  ))
  (( = CalqueActif "A_01_1H_PIETON STABILISE" ) (setq Type-Hach_ "GRAVEL" Ech_  0.05  ))
  (( = CalqueActif "A_01_1H_ENGAZ" ) (setq Type-Hach_ "GRASS" Ech_  0.07  ))
(T nil)
  
)  
(if ( not (or (= calqueActif "A_01_1H_VOIRIE")( = CalqueActif "A_01_1H_PK" )( = CalqueActif "A_01_1H_ACCES" )( = CalqueActif "A_01_1H_TROTT" )
		( = CalqueActif "A_01_1H_PIETON STABILISE" )( = CalqueActif "A_01_1H_ENGAZ" ))
)
(setq Type-Hach_ "LINE" Ech_  0.2  ))
 )
  	

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun creelist	( / anccalq calqueH listcalque nomcalque Key0 key8 key1  ssobjet nbr_Obj ID-Ent entH rep Ech ind f1 testalert col)

;;;(setq 
;;;	SavErr *error*
;;;	*error* G-ERROR
;;; ;)
 	(setvar "CMDECHO" 0)
(command "_.undo" "_begin")
 	(setq  anccalq (getvar "CLAYER") )
  	(setq ind 0 surf 0)
 	(setq col 11)
   	(setq f1 (open "G:/Surf2.txt" "w"))
 	(setq listcalque (list) )
(initget "Couleur Noir")
   	(setq rep (getkword "\nCouleur / Noir et blanc ? "))
	


 (while (setq nomcalque (cdr (assoc 2 (tblnext "LAYER"))))	
(if 	(= T   (wcmatch  nomcalque "A_01_1C_*"))	
	
 	(setq listcalque
		(append listcalque
    		(list nomcalque)
		)	
 	)

)
 )


(mapcar  '(lambda (x)
  			
  	(setq CalqueH 	(strcat (substr x 1 5 ) "1H" (substr x 8)) )

	(if ( = rep "Couleur")
  	( setq Type-Hach_ "SOLID")
  	(hachures CalqueH)
  	
 	)

	;;; creation de calques manquants
(command "_-layer" "_N"  CalqueH "" )
	(setq col (+ col 10))
	;;; creation de hachures sur calques manquants	

	(setq Key8 (cons 8 CalqueH)
 		Key9 (cons 8 x)
     		Key0 (cons 0 "HATCH")
     		Key1 (cons 0 "LWPOLYLINE" ))
                      		
		
 	;;; Efface les hachures existantes sur le calque x
 	(if (setq sshach (ssget "X" (list Key8 Key0 )))
       	(erasEnt-JS sshach )
)
   	

;;; Selection des polylignes sur le calque x
 	(setq ssObjet(ssget "X" (list Key9 Key1)) ) 
(if	ssObjet 
(progn
	(setvar "CLAYER" CalqueH )	
 	(setq nbr_Obj (sslength ssObjet))
   	
	
 		(setq ID-Ent 0);initialisation de ID-Ent
	(repeat nbr_Obj
 		
 		(setq entH (ssname ssObjet ID-Ent)) ; création de entH
	(fermepoly )
 		
           	(command "_AREA" "_E"  (ssname ssObjet ID-Ent))
	(surface)
 		(cond
 		((= Type-Hach_ "SOLID")
      	(command "-fhach"		"p"		Type-Hach_	"a"		"a"		"o"		""		"t"   "a"		"s"		entH	""		""   	)
 		)
;;;hachurage solid
 		((/= Type-Hach_ "SOLID")
 			(command "-fhach"   "p"   Type-Hach_ 	Ech_	"0" "a" "a"   "o" "" "t" "a" "s" entH   ""  ""   	)
 		)
;;; hachure non solid

 		(T nil)
	)
    	(setq ID-Ent (+ ID-Ent 1));;;identificateur suivant
	)


 	
 	)

 	)

;; Ecriture des surfaces dans un fichier txt
 
(write-line (strcat x ";" (rtos surf 2 2)) f1)
  	
 	(setq surf 0)

	); fin de lambda
	
		listcalque
	
) ; mapcar

  (if testAlert
 		(Alert testAlert)
 	) 
;(setvar "CLAYER" anccalque)
(tblnext "LAYER" T)
(setq f1 (close f1))
;(command "_.undo" "_end")
;(G-ERROR "")
 (princ)
)

 

D'avance Merci

Sapin

[GEGEMATIC]

salut,

chez moi, le problème est que le lecteur G: n'existe pas

remplacer

(setq f1 (open "G:/Surf2.txt" "w"))

par

(setq f1 (open (strcat (getvar "dwgprefix") "Surf2.txt") "w"))

et la routine marche.

 

soit dit en passant, je remplacerai également .txt par .csv

Gégé

[grand_sapin]

Salut,

 

merci pour l'astuce du CSV, cependant, ACAD continue de m'écrire "commande inconnue" quand je la lance.

d'où est-ce que ça peut venir ? Alors que tu me dit que la commande fonctionne chez toi.

 

Sapin

[GEGEMATIC]

salut,

je ne sais pas comment il utilisait sa routine, à partir d'une menu etc ...

donc pour lancer la commande il faut des parenthèses :

(creelist)

 

sinon, pour la lancer directement :

command: creelist

il faut faire (defun c:creelist au lieu de (defun creelist

[grand_sapin]

ah c'est pour ça ! Effectivement, elle était lancée à partir d'une barre d'outils perso.

ça marche nickel.

 

Merci Gégé !

 

Sapin