-
Notifications
You must be signed in to change notification settings - Fork 1
/
ktri_collecteur_EC-EU.lsp
219 lines (207 loc) · 6.8 KB
/
ktri_collecteur_EC-EU.lsp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
(defun C:ktri_collecteur_EC-EU ()
(setq
NomDuBlocAChercher "RAE_PT_RACCORDEMENT"
NomDeLAttributAChercher "Contenu"
RayonDuCercleACreer 0.5
)
(entmake (list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 "S+N - EC - collecteur") ;; nom du calque
(cons 70 0)
(cons 62 160) ;; couleur du calque
(cons 6 "Continuous") ;; type de ligne
))
(entmake (list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 "S+N - EU - collecteur")
(cons 70 0)
(cons 62 10) ;; couleur du calque
(cons 6 "Continuous") ;; type de ligne
))
(entmake (list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 "S+N - Désactivé") ;; nom du calque
(cons 70 0)
(cons 62 252) ;; couleur du calque
(cons 6 "Continuous") ;; type de ligne
))
(setq
NombreDeBlocsATrier nil
NombreDeBlocsEC 0
NombreDeBlocsEU 0
NombreDeBlocsAutre 0
ListeTermesEC nil
ListeTermesEU nil
)
(princ "\nSelectionnez les objets a traiter:")
(setq
ssbase (ssget) ;; creation du jeu de selection ss avec tout les objets à traiter
i 0 ;; compteur
)
;; test de la selection d'objet
(if (= nil ssbase)
(progn
(print "\nPas d'objets sélectionnés, sortie du programme")
(quit)
)
(print "\nListe des objets séléctionnés non nulle, suite du programme")
)
;; boucle de tri pour séparer les blocs
(setq ssblock (ssadd))
(repeat (sslength ssbase)
(setq ent (ssname ssbase i)) ;; définir l'entité à tester
(setq lstdxf (entget ent)) ;; lui extraire ses données DXf pour pouvoir tester
(setq enttype (cdr (assoc 0 lstdxf))) ;; extrait le type d'objet de l'entité
(cond
((= enttype "INSERT") (ssadd ent ssblock)) ;; si c'est un block, l'entitée est ajoutée à la liste de block
)
(setq i (1+ i))
)
;; test de la liste de bloc
(if (= ssblock nil)
(progn
(print "\nPas de blocks sélectionnées, sortie du programme")
(quit)
)
(print "\nListe des blocs non nulle, suite du programme")
)
(setq ssblockfinal ssblock) ;;ligne remplacant le code si dessous
;; tri des blocs (seulement "RAE_REGARD_CHAMBRE")
;;(setq i 0)
;;(setq ssblockfinal (ssadd))
;;(repeat (sslength ssblock)
;; (setq ent (ssname ssblock i))
;; (setq lstdxf (entget ent))
;; (setq entnom (cdr (assoc 2 lstdxf)))
;; (cond
;; ((= entnom NomDuBlocAChercher) (ssadd ent ssblockfinal))
;; )
;; (setq i (1+ i))
;; )
;; test de la liste créée
;;(if (= ssblockfinal nil)
;; (progn
;; (print "\nPas de blocs avec le bon nom, sortie du programme")
;; (quit)
;; )
;; (progn
;; (print "\nBlocs avec le bon nom existants, suite du programmme")
;; (setq NombreDeBlocsATrier (sslength ssblockfinal))
;; )
;; )
;; boucle de tri des blocs dans les bons calques
(setq i 0)
(repeat (sslength ssblockfinal) ;; début de la boucle
(setq EntBlock (ssname ssblockfinal i)) ;; nom d'entité du block
(setq lstdxf (entget EntBlock)) ;; definition du block
(setq PointInsertion (cdr (assoc 10 lstdxf))) ;; point d'insertion du bloc
(setq AttText nil) ;; reset du texte de l'attribut
(setq EntAtt (entnext EntBlock)) ;; nom d'entité de l'entité suivante
(setq EntAttLstdxf (entget EntAtt)) ;; définition de l'entité
(while (not (= (cdr (assoc 0 EntAttLstdxf)) "SEQEND")) ;; début de la boucle des attribut
(if ;; si
(and
(= (cdr (assoc 0 EntAttLstdxf)) "ATTRIB") ;; c'est une entité "attribu"
(= (cdr (assoc 2 EntAttLstdxf)) NomDeLAttributAChercher) ;; le nom de l'entité "attribu" est "CONTENU"
)
(setq AttText (cdr (assoc 1 EntAttLstdxf))) ;; aller chercher le texte de l'entité "attribu"
)
(setq EntAtt (entnext EntAtt)) ;; nom d'entité de l'entité suivante
(setq EntAttLstdxf (entget EntAtt)) ;; définition de l'entité
)
(setq
choixEcEu nil
EstDansEC 0
EstDansEU 0
)
(if (or (= AttText nil) (= AttText "")) ;; si le texte de l'attribut est null ou contient aucun caractère
(setq NombreDeBlocsAutre (+ NombreDeBlocsAutre 1)) ;; alors rien
(progn ;; sinon
(setq i2 0)
(repeat (length ListeTermesEC) ;; boucle de recherche dans la liste de terme pour EC
(if (= (nth i2 ListeTermesEC) AttText)
(setq EstDansEC 1)
)
(setq i2 (+ i2 1))
)
(setq i2 0)
(repeat (length ListeTermesEU) ;; boucle de recherche dans la liste de terme pour EU
(if (= (nth i2 ListeTermesEU) AttText)
(setq EstDansEU 1)
)
(setq i2 (+ i2 1))
)
(if (and (= EstDansEC 0) (= EstDansEU 0)) ;; si le texte de l'attribut n'est ni dans la liste EC ni dans la liste EU
(progn
(setq TexteChoixECEU (strcat "\nLe terme """ AttText """ n'est pas défini dans les liste. De quelle liste fait-il partie? [EC/EU/Autre]"))
(initget 1 "eC eU Autre")
(setq choixEcEu (getkword TexteChoixECEU))
(if (= choixEcEu "eC")
(setq
EstDansEC 1
ListeTermesEC (append (list AttText) ListeTermesEC)
)
)
(if (= choixEcEu "eU")
(setq
EstDansEU 1
ListeTermesEU (append (list AttText) ListeTermesEU)
)
)
(if (= choixEcEu "Autre")
(setq NombreDeBlocsAutre (+ NombreDeBlocsAutre 1))
)
)
)
(if (= EstDansEC 1) ;; si il est dans la liste de terme EC
(progn
(setq lstdxf (subst (cons 8 "S+N - EC - collecteur") (assoc 8 lstdxf) lstdxf))
(entmod lstdxf)
(princ EntBlock)
(setq NombreDeBlocsEC (+ NombreDeBlocsEC 1))
;;(entmakex (list
;; (cons 0 "CIRCLE")
;; (cons 8 "S+N - EC - Chambre")
;; (cons 10 PointInsertion)
;; (cons 40 RayonDuCercleACreer)
;; ))
)
)
(if (= EstDansEU 1) ;; si il est dans la liste de terme EU
(progn
(setq lstdxf (subst (cons 8 "S+N - EU - collecteur") (assoc 8 lstdxf) lstdxf))
(entmod lstdxf)
(princ EntBlock)
(setq NombreDeBlocsEU (+ NombreDeBlocsEU 1))
;;(entmakex (list
;; (cons 0 "CIRCLE")
;; (cons 8 "S+N - EU - Chambre")
;; (cons 10 PointInsertion)
;; (cons 40 RayonDuCercleACreer)
;; ))
)
)
)
)
(setq i (+ i 1))
)
(prompt (strcat
"\nNombre de blocs à triées:"
(rtos NombreDeBlocsATrier 2 0)
"\nNombre de blocs triés:"
(rtos (+ NombreDeBlocsAutre NombreDeBlocsEC NombreDeBlocsEU) 2 0)
"( EC:"
(rtos NombreDeBlocsEC 2 0)
" EU:"
(rtos NombreDeBlocsEU 2 0)
" Autres:"
(rtos NombreDeBlocsAutre 2 0)
")\n"
))
)