-
Notifications
You must be signed in to change notification settings - Fork 1
/
kbordure_points.lsp
377 lines (341 loc) · 14.3 KB
/
kbordure_points.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
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
(defun C:kbordure_points ()
(defun aucarre (asdf) (* asdf asdf))
(setq
;; décalage sur X des points d'insertions des textes dans le tableau depuit la ligne verticale la plus à gauche du tableau
;; tableauDecalageKilometrage 2.00 (annulé)
tableauDecalageNumero 1.35
tableauDecalageCoordonneeX 5.05
tableauDecalageCoordonneeY 9.75
tableauDecalageCoordonneeZ 14.45
;; tableauDecalageRemarque 17.05 (annulé)
;; décalage sur X des lignes verticales du tableau par rapport à la ligne la plus à gauche du tableau
;; tableauLigneVerticale1Decalage 3.90 (annulé)
tableauLigneVerticale2Decalage 2.70
tableauLigneVerticale3Decalage 7.40
tableauLigneVerticale4Decalage 12.10
tableauLigneVerticale5Decalage 16.80
tableauLigneVerticale6Decalage 20.15
tableauLigneVerticaleDroiteDecalage 23.50
;; décalage sur Y des objets du tableau
tableauHauteurLigne 0.9
tableauDecalagetexteLigne 0.45
;;informations des objets textes dans le tableau
tableauHauteurTexte 0.6
tableauPolice "ARIAL"
)
(if (= (tblsearch "STYLE" "ARIAL") nil)
(progn
(print "\nLe style de texte \"ARIAL\" n'existe pas. \nLes objets qui devaient être créer avec ce style seront créer avec le style de texte courant. ")
(setq tableauStyleTexte (getvar "textstyle"))
)
(setq tableauStyleTexte "ARIAL")
)
(setq
;; informations sur les objets en situation
situDecalageTexte 1
situAzimutTexte 0
situHauteurTexte 0.5
situRotationTexte (* 3.0 (/ pi 2.00))
situPolice "ARIAL"
)
(if (= (tblsearch "STYLE" "ARIAL") nil)
;; pas besoin de rajouter le texte "Le style "ARIAL" n'héxiste pas..." car déjà mis avant
(setq situStyleTexte (getvar "textstyle"))
(setq situStyleTexte "ARIAL")
)
(if (= SituAltitude nil)
(setq SituAltitude 0.0)
)
(setq style (getvar "textstyle"))
;; informations sur les calques
(if (= (tblsearch "LAYER" "tableaux coordonnées points - 010") nil) ;;calque TableauLigneHorizontalMineurCalque
(progn
(print "\nLe calque \"tableaux coordonnées points - 010\" n'existe pas. \nLes objets qui devaient être créer dans ce calque seront mis dans le calque \"0\". ")
(setq TableauLigneHorizontalMineurCalque "0")
)
(setq TableauLigneHorizontalMineurCalque "tableaux coordonnées points - 010")
)
(if (= (tblsearch "LAYER" "tableaux coordonnées points - 050") nil) ;;calques TableauLigneHorizontalMajeurCalque TableauLigneVerticalMajeurCalque
(progn
(print "\nLe calque \"tableaux coordonnées points - 050\" n'existe pas. \nLes objets qui devaient être créer dans ce calque seront mis dans le calque \"0\". ")
(setq
TableauLigneHorizontalMajeurCalque "0"
TableauLigneVerticalMajeurCalque "0"
)
)
(setq
TableauLigneHorizontalMajeurCalque "tableaux coordonnées points - 050"
TableauLigneVerticalMajeurCalque "tableaux coordonnées points - 050"
)
)
(if (= (tblsearch "LAYER" "tableaux coordonnées points - 013") nil) ;;calque TableauLigneVerticalMineurCalque
(progn
(print "\nLe calque \"tableaux coordonnées points - 013\" n'existe pas. \nLes objets qui devaient être créer dans ce calque seront mis dans le calque \"0\". ")
(setq TableauLigneVerticalMineurCalque "0")
)
(setq TableauLigneVerticalMineurCalque "tableaux coordonnées points - 013")
)
(if (= (tblsearch "LAYER" "Points") nil) ;; calque SituPointCalqueBordure
(progn
(print "\nLe calque \"Points\" n'existe pas. \nLes objets qui devaient être créer dans ce calque seront mis dans le calque \"0\". ")
(setq SituPointCalqueBordure "0")
)
(setq SituPointCalqueBordure "Points")
)
(if (= (tblsearch "LAYER" "Point avec changement de rayon") nil) ;; calque SituPointCalqueGeometrie
(progn
(print "\nLe calque \"Point avec changement de rayon\" n'existe pas. \nLes objets qui devaient être créer dans ce calque seront mis dans le calque \"0\". ")
(setq SituPointCalqueGeometrie "0")
)
(setq SituPointCalqueGeometrie "Point avec changement de rayon")
)
(if ;;si ces deux calques existent, un choix sera disponible plus tard. Sinon pas de choix.
(or
(= (tblsearch "LAYER" "Points") nil)
(= (tblsearch "LAYER" "Point avec changement de rayon") nil)
)
(setq ChoixTypePoint "NON")
(setq ChoixTypePoint "OUI")
)
;;entrées utilisateurs
(initget 1)
(setq pointInsertionTableau (getpoint "\nChoisissez un point qui sera le coin haut gauche du tableau de coordonnée:"))
(setq CoinHautGaucheligneTexte pointInsertionTableau)
(setq numeroPoint (getreal "\nDéfinissez le numéro du premier point: "))
(if (= numeroPoint nil) (setq numeroPoint 1))
;; début de la boucle
(while
;; entrées utilisateur
;;point d'insertion
(/= (setq Point1U (getpoint "\nChoisissez un point sur la bordure ou ENTER pour mettre fin à la commande: ")) nil)
(setq Point1W (trans Point1U 1 0))
;;orientationkp
(if (= AncienOrientationTexteU nil)
(setq TexteOrientation "\nChoisissez l'orientation du texte: ")
(setq TexteOrientation "\nChoisissez l'orientation du texte ou ENTER pour prendre l'orientation du texte précedent: ")
)
(if (= AncienOrientationTexteU nil)
(initget 1)
)
(setq Point2U (getpoint Point1U TexteOrientation))
(if (= Point2U nil)
(setq OrientationTexteU AncienOrientationTexteU)
(progn
(setq dxU (- (car Point2U) (car Point1U)))
(setq dyU (- (cadr Point2U) (cadr Point1U)))
(setq OrientationTexteU (atan dyU dxU))
(setq Point2W (trans Point2U 1 0))
(setq dxW (- (car Point2W) (car Point1W)))
(setq dyW (- (cadr Point2W) (cadr Point1W)))
(setq difference_angle (- (atan dyU dxU) (atan dyW dxW)))
(setq OrientationTexteW (- OrientationTexteU difference_angle))
)
)
(setq AncienOrientationTexteU OrientationTexteU)
;; choix du type de point
(if (= ChoixTypePoint "OUI")
(progn
(if (= AncienOptionTypeBordure nil)
(setq TexteChoixTypeBordure (strcat "\nQu'elle est ce point? Un [changement de Type / changement de la Geometrie]?"))
(setq TexteChoixTypeBordure (strcat
"\nQu'elle est ce point? Un [changement de Type / changement de la Geometrie]? <"
(if (= AncienOptionTypeBordure "Type") "changement de Type" "changement de Geometrie")
">"
))
)
(if (= AncienOptionTypeBordure nil)
(initget 1 "Type Geometrie")
(initget "Type Geometrie")
)
(setq OptionTypeBordure (getkword TexteChoixTypeBordure)) ;;entrée utilisateur
(if (= OptionTypeBordure nil)
(setq OptionTypeBordure AncienOptionTypeBordure)
)
(if (= OptionTypeBordure "Type")
(setq SituPointCalque SituPointCalqueBordure)
)
(if (= OptionTypeBordure "Geometrie")
(setq SituPointCalque SituPointCalqueGeometrie)
)
(setq AncienOptionTypeBordure OptionTypeBordure)
)
(setq SituPointCalque SituPointCalqueBordure)
)
;; socker les variables systeme et les mettre à 0
(setq
os (getvar "osmode")
dim (getvar "dimzin")
)
(setvar "osmode" 0)
(setvar "dimzin" 0)
;; création du point gauche en situation et stockage de son id
(setq SituInsertionObjetPoint Point1W)
(setq SituInsertionObjetPoint (list (car SituInsertionObjetPoint) (cadr SituInsertionObjetPoint) SituAltitude))
(setq idObjectPoint (entmakex (list
(cons 0 "POINT")
(cons 8 SituPointCalque)
(cons 10 SituInsertionObjetPoint)
)))
;; création des textes de coordonnées du point gauche dans le tableau
(setq TableauTextePointGaucheCoordonneeX (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID(vlax-ename->vla-object idObjectPoint))) ">%).Coordinates \\f \"%lu2%pt1%pr2\">%"))
(entmakex ;; création du texte
(list
(cons 0 "TEXT")
(cons 8 SituPointCalqueBordure)
(cons 10 (list 0 0 0 ))
(cons 40 tableauHauteurTexte)
(cons 1 TableauTextePointGaucheCoordonneeX)
(cons 50 difference_angle)
(cons 7 tableauStyleTexte)
(cons 72 1)
(cons 73 2)
(cons 11 (list (+ (car CoinHautGaucheligneTexte) tableauDecalageCoordonneeX) (- (cadr CoinHautGaucheligneTexte) tableauDecalagetexteLigne) 0.0 ))
)
)
(setq TableauTextePointGaucheCoordonneeY (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID(vlax-ename->vla-object idObjectPoint))) ">%).Coordinates \\f \"%lu2%pt2%pr2\">%"))
(entmakex ;; création du texte
(list
(cons 0 "TEXT")
(cons 8 SituPointCalqueBordure)
(cons 10 (list 0 0 0 ))
(cons 40 tableauHauteurTexte)
(cons 1 TableauTextePointGaucheCoordonneeY)
(cons 50 difference_angle)
(cons 7 tableauStyleTexte)
(cons 72 1)
(cons 73 2)
(cons 11 (list (+ (car CoinHautGaucheligneTexte) tableauDecalageCoordonneeY) (- (cadr CoinHautGaucheligneTexte) tableauDecalagetexteLigne) 0.0 ))
)
)
(setq TableauTextePointGaucheCoordonneeZ (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID(vlax-ename->vla-object idObjectPoint))) ">%).Coordinates \\f \"%lu2%pt4%pr2\">%"))
(entmakex ;; création du texte
(list
(cons 0 "TEXT")
(cons 8 SituPointCalqueBordure)
(cons 10 (list 0 0 0 ))
(cons 40 tableauHauteurTexte)
(cons 1 TableauTextePointGaucheCoordonneeZ)
(cons 50 difference_angle)
(cons 7 tableauStyleTexte)
(cons 72 1)
(cons 73 2)
(cons 11 (list (+ (car CoinHautGaucheligneTexte) tableauDecalageCoordonneeZ) (- (cadr CoinHautGaucheligneTexte) tableauDecalagetexteLigne) 0.0 ))
)
)
;; création du texte de numéro de point gauche dans le tableau et stockage de son ID
(setq TableauTextePointGaucheNumero (rtos numeroPoint 2 0))
(setq idTexteNumero (entmakex ;; création du texte
(list
(cons 0 "TEXT")
(cons 8 SituPointCalque)
(cons 10 (list 0 0 0 ))
(cons 40 tableauHauteurTexte)
(cons 1 TableauTextePointGaucheNumero)
(cons 50 difference_angle)
(cons 7 tableauPolice)
(cons 72 1)
(cons 73 2)
(cons 11 (list (+ (car CoinHautGaucheligneTexte) tableauDecalageNumero) (- (cadr CoinHautGaucheligneTexte) tableauDecalagetexteLigne) 0.0 ))
)
))
;; création du texte de numéro de point en situation
(setq situTextePointGaucheNumero (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID(vlax-ename->vla-object idTexteNumero))) ">%).TextString>%"))
(setq situInsertionObjetNumero (polar Point1W (+ OrientationTexteW situAzimutTexte) situDecalageTexte))
(setq situInsertionObjetNumero (list (car situInsertionObjetNumero) (cadr situInsertionObjetNumero) 0.0))
(entmakex ;; création du texte
(list
(cons 0 "TEXT")
(cons 8 SituPointCalque)
(cons 10 (list 0 0 0 ))
(cons 40 situHauteurTexte)
(cons 1 situTextePointGaucheNumero)
(cons 50 (+ OrientationTexteW situRotationTexte))
(cons 7 situStyleTexte)
(cons 72 1)
(cons 73 2)
(cons 11 situInsertionObjetNumero)
)
)
;; création de la ligne en dessous des textes
(setq idObjectLine (entmakex (list
(cons 0 "LINE")
(cons 8 TableauLigneHorizontalMineurCalque)
(cons 10 (list (car CoinHautGaucheligneTexte) (- (cadr CoinHautGaucheligneTexte) tableauHauteurLigne) 0.0 ))
(cons 11 (list (+ (car CoinHautGaucheligneTexte) tableauLigneVerticale5Decalage) (- (cadr CoinHautGaucheligneTexte) tableauHauteurLigne) 0.0 ))
)))
;; incrémentation de 1 du numéro de point
(setq
numeroPoint (+ numeroPoint 1)
CoinHautGaucheligneTexte (list (car CoinHautGaucheligneTexte) (- (cadr CoinHautGaucheligneTexte) tableauHauteurLigne) 0.0)
)
;; variable de fin de profil principal
(setvar "osmode" os)
(setvar "dimzin" dim)
;; reinitialisation des variables
(setq
Point1U nil
Point2U nil
Point1W nil
Point2W nil
dxU nil
dyU nil
dxW nil
dyW nil
)
)
;; fin de boucle
;; Création des lignes vérticales
(entmakex (list
(cons 0 "LINE")
(cons 8 TableauLigneVerticalMineurCalque)
(cons 10 (list (+ (car pointInsertionTableau) tableauLigneVerticale2Decalage) (cadr pointInsertionTableau) 0.0 ))
(cons 11 (list (+ (car pointInsertionTableau) tableauLigneVerticale2Decalage) (cadr CoinHautGaucheligneTexte) 0.0 ))
))
(entmakex (list
(cons 0 "LINE")
(cons 8 TableauLigneVerticalMineurCalque)
(cons 10 (list (+ (car pointInsertionTableau) tableauLigneVerticale3Decalage) (cadr pointInsertionTableau) 0.0 ))
(cons 11 (list (+ (car pointInsertionTableau) tableauLigneVerticale3Decalage) (cadr CoinHautGaucheligneTexte) 0.0 ))
))
(entmakex (list
(cons 0 "LINE")
(cons 8 TableauLigneVerticalMineurCalque)
(cons 10 (list (+ (car pointInsertionTableau) tableauLigneVerticale4Decalage) (cadr pointInsertionTableau) 0.0 ))
(cons 11 (list (+ (car pointInsertionTableau) tableauLigneVerticale4Decalage) (cadr CoinHautGaucheligneTexte) 0.0 ))
))
(entmakex (list
(cons 0 "LINE")
(cons 8 TableauLigneVerticalMineurCalque)
(cons 10 (list (+ (car pointInsertionTableau) tableauLigneVerticale5Decalage) (cadr pointInsertionTableau) 0.0 ))
(cons 11 (list (+ (car pointInsertionTableau) tableauLigneVerticale5Decalage) (cadr CoinHautGaucheligneTexte) 0.0 ))
))
(entmakex (list
(cons 0 "LINE")
(cons 8 TableauLigneVerticalMineurCalque)
(cons 10 (list (+ (car pointInsertionTableau) tableauLigneVerticale6Decalage) (cadr pointInsertionTableau) 0.0 ))
(cons 11 (list (+ (car pointInsertionTableau) tableauLigneVerticale6Decalage) (cadr CoinHautGaucheligneTexte) 0.0 ))
))
;; Création de la liste de points du cadre
(setq liste
(list
(cons 10 pointInsertionTableau)
(cons 10 (list (car pointInsertionTableau) (cadr CoinHautGaucheligneTexte) 0.0))
(cons 10 (list (+ (car pointInsertionTableau) tableauLigneVerticaleDroiteDecalage) (cadr CoinHautGaucheligneTexte) 0.0))
(cons 10 (list (+ (car pointInsertionTableau) tableauLigneVerticaleDroiteDecalage) (cadr pointInsertionTableau) 0.0))
))
(entmakex ;; création du cadre
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 8 TableauLigneVerticalMajeurCalque)
(cons 100 "AcDbPolyline")
(cons 90 (length liste))
(cons 70 1)
)
liste
)
)
;; suppression de la dernière ligne horizontale
(entdel idObjectLine)
)