-
Notifications
You must be signed in to change notification settings - Fork 40
/
generar-gml_v3_0_4.lsp
1215 lines (1201 loc) · 56.3 KB
/
generar-gml_v3_0_4.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
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;; Script AutoLisP generar-gml.lsp
;;;;;;;;;;;
;;;;;;;;;;; LIMITACION DE RESPONSABILIDAD: No se proporciona soporte de este script. El script se proporciona tal cual es sin responsabilidad ni garantía de ningún tipo. Los autores se eximen de toda garantia implícita incluyendo, sin limitación, cualquier garantía de comerciabilidad o de idoneidad para un propósito en particular. Usted asume todo el riesgo surgido por el uso o el funcionamiento del script y su documentación. En ningún caso serán sus autores, o cualquier otra persona involucrada en la creación, producción o distribución del script responsable por los daños y perjuicios (incluyendo, sin limitación, daños por pérdida de beneficios empresariales, interrupción de negocio, pérdida de información comercial u otra perdida pecuniaria) derivados del uso o la incapacidad de usar el script y su documentación, incluso si no ha sido advertido de la posibilidad de tales daños.
;;;;;;;;;;;
;;;;;;;;;;; LICENCIA PÚBLICA GENERAL (GNU GPL v3): Copyright (C) 2016 ChapulinCatastral https://github.com/chapulincatastral/ . Este programa es software libre. Puede redistribuirlo y/o modificarlo bajo los términos de la Licencia Pública General de GNU tal como está publicada por la Free Software Foundation, bien de la versión 3 de dicha Licencia o bien (según su elección) de cualquier versión posterior. Este programa se distribuye con la esperanza de que sea útil, pero SIN NINGUNA GARANTÍA, incluso sin la garantía MERCANTIL implícita o sin garantizar la CONVENIENCIA PARA UN PROPÓSITO PARTICULAR. Véase la Licencia Pública General de GNU para más detalles. Usted debería haber recibido una copia de la Licencia Pública General junto con este programa. Si no ha sido así, consulte <http://www.gnu.org/licenses>.
;;;;;;;;;;;
;;;;;;;;;;; version: 1.0.0; fecha: 10.10.2016; Autor: Castell Cebolla, Alvaro Alvarez, Pepe Alacreu; Modificacion: Genera GML de Parcela Catastral
;;;;;;;;;;; version: 2.0.0; fecha: 11.11.2016; Autor: Alvaro; Modificación: soporte para; islas, identificador de parcela y tipo identificador de parcela
;;;;;;;;;;; version: 3.0.0; fecha: 12.12.2016; Autor: Alvaro; Modificación: se añade GMLe que genera GML de edificio.
;;;;;;;;;;; version: 3.0.1; fecha: 12.12.2016; Autor: Alvaro, Castell ; Modificación: Se filtran las "entidades arco" en las polilíneas cerradas.
;;;;;;;;;;; version: 3.0.2; fecha: 16.12.2016; Autor: Alvaro; Modificación: Se permiten número de viviendas 0 y se modifican textos y descripción del formulario.
;;;;;;;;;;; version: 3.0.3; fecha: 17.12.2016; Autor: Alvaro; Modificación: Cambiamos el gmle para generar una coord. por línea y facilitar el "copy paste" de coord. 8-)
;;;;;;;;;;; version: 3.0.4; fecha: 21.12.2016; Autor: Alvaro; Modificación: Comprobar que los identificadores de parcela de GML de Parcela no contienen espacios en blanco
;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn ; Plantillas de fichero GML de Edificio
(setq fichero_gml_1 "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>
<!--Instancia de ejemplo de edificio.-->
<gml:FeatureCollection gml:id=\"ES.SDGC.BU\" xmlns:ad=\"urn:x-inspire:specification:gmlas:Addresses:3.0\" xmlns:base=\"urn:x-inspire:specification:gmlas:BaseTypes:3.2\" xmlns:bu-base=\"http://inspire.jrc.ec.europa.eu/schemas/bu-base/3.0\" xmlns:bu-core2d=\"http://inspire.jrc.ec.europa.eu/schemas/bu-core2d/2.0\" xmlns:bu-ext2d=\"http://inspire.jrc.ec.europa.eu/schemas/bu-ext2d/2.0\" xmlns:cp=\"urn:x-inspire:specification:gmlas:CadastralParcels:3.0\" xmlns:el-bas=\"http://inspire.jrc.ec.europa.eu/schemas/el-bas/2.0\" xmlns:el-cov=\"http://inspire.jrc.ec.europa.eu/schemas/el-cov/2.0\" xmlns:el-tin=\"http://inspire.jrc.ec.europa.eu/schemas/el-tin/2.0\" xmlns:el-vec=\"http://inspire.jrc.ec.europa.eu/schemas/el-vec/2.0\" xmlns:gco=\"http://www.isotc211.org/2005/gco\" xmlns:gmd=\"http://www.isotc211.org/2005/gmd\" xmlns:gml=\"http://www.opengis.net/gml/3.2\" xmlns:gmlcov=\"http://www.opengis.net/gmlcov/1.0\" xmlns:gn=\"urn:x-inspire:specification:gmlas:GeographicalNames:3.0\" xmlns:gsr=\"http://www.isotc211.org/2005/gsr\" xmlns:gss=\"http://www.isotc211.org/2005/gss\" xmlns:gts=\"http://www.isotc211.org/2005/gts\" xmlns:swe=\"http://www.opengis.net/swe/2.0\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xsi:schemaLocation=\"http://inspire.jrc.ec.europa.eu/schemas/bu-ext2d/2.0 http://inspire.ec.europa.eu/draft-schemas/bu-ext2d/2.0/BuildingExtended2D.xsd\">
<gml:featureMember>
<bu-ext2d:Building gml:id=\"ES.LOCAL.1\">
<bu-core2d:beginLifespanVersion xsi:nil=\"true\" nilReason=\"other:unpopulated\"/>
<!--PONER AQUI SI ES FUNCIONAL O EN CONSTRUCCION.-->
<bu-core2d:conditionOfConstruction>%OBRA%</bu-core2d:conditionOfConstruction>")
(setq fichero_gml_2 "\n <bu-core2d:dateOfConstruction>
<!--FECHA DE CONSTRUCCION SI ES FUNCIONAL.-->
<bu-core2d:DateOfEvent>
<bu-core2d:beginning>%FECHA-INICIO%T00:00:00</bu-core2d:beginning>
<bu-core2d:end>%FECHA-FIN%T00:00:00</bu-core2d:end>
</bu-core2d:DateOfEvent>
</bu-core2d:dateOfConstruction>")
(setq fichero_gml_3 "\n <bu-core2d:endLifespanVersion xsi:nil=\"true\" nilReason=\"other:unpopulated\"/>
<bu-core2d:inspireId>
<base:Identifier>
<!--IDENTIFICATIVO DE LA FINCA Y EDIFICIO.-->
<base:localId>%REFERENCIA-PARCELA%</base:localId>
<base:namespace>ES.LOCAL.BU</base:namespace>
</base:Identifier>
</bu-core2d:inspireId>
<bu-ext2d:geometry>
<bu-core2d:BuildingGeometry>
<bu-core2d:geometry>
<!--EL SRSNAME ES EL SISTEMA DE REFERENCIA DE LAS COORDENADAS. DEBE COINCIDIR CON EL DE LA CARTOGRAFIA CATASTRAL DEL MUNICIPIO.-->
<gml:Surface gml:id=\"surface_ES.LOCAL.1\" srsName=\"urn:ogc:def:crs:%HUSO%\">
<gml:patches>")
(setq fichero_gml_PolygonPatch "\n <gml:PolygonPatch>
<gml:exterior>
<gml:LinearRing>
<!--LISTA DE COORDENADAS-->
<gml:posList>
%COORDENADAS%
</gml:posList>
</gml:LinearRing>
</gml:exterior>
</gml:PolygonPatch>")
(setq fichero_gml_4 "\n </gml:patches>
</gml:Surface>
</bu-core2d:geometry>
<!--AQUI HAY QUE PONER LA PRECISION REAL DE LAS COORDENADAS-->
<bu-core2d:horizontalGeometryEstimatedAccuracy uom=\"m\">%PRECISION%</bu-core2d:horizontalGeometryEstimatedAccuracy>
<bu-core2d:horizontalGeometryReference>footPrint</bu-core2d:horizontalGeometryReference>
<bu-core2d:referenceGeometry>true</bu-core2d:referenceGeometry>
</bu-core2d:BuildingGeometry>
</bu-ext2d:geometry>")
(setq fichero_gml_5 "\n<!-- USO PRINCIPAL, SI ES CONOCIDO-->
<bu-ext2d:currentUse>%USO%</bu-ext2d:currentUse>")
(setq fichero_gml_6 "\n<!-- NUMERO DE INMUEBLES-->
<bu-ext2d:numberOfBuildingUnits>%INMUEBLES%</bu-ext2d:numberOfBuildingUnits>
<!-- NUMERO DE VIVIENDAS-->
<bu-ext2d:numberOfDwellings>%VIVIENDAS%</bu-ext2d:numberOfDwellings>
<!-- NUMERO DE PLANTAS SOBRE RASANTE-->
<bu-ext2d:numberOfFloorsAboveGround>%PLANTAS%</bu-ext2d:numberOfFloorsAboveGround>
<bu-ext2d:officialArea>
<bu-ext2d:OfficialArea>
<bu-ext2d:officialAreaReference>grossFloorArea</bu-ext2d:officialAreaReference>
<!-- SUPERFICIE CONSTRUIDA TOTAL EN M2-->
<bu-ext2d:value uom=\"m2\">%SUPERFICIE%</bu-ext2d:value>
</bu-ext2d:OfficialArea>
</bu-ext2d:officialArea>
</bu-ext2d:Building>
</gml:featureMember>
</gml:FeatureCollection>")
); progn ; Plantilla GML de Edificio
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn ; Plantillas de fichero GML de Parcela
(setq plantilla1 "<?xml version=\"1.0\" encoding=\"utf-8\"?>
<!--Parcela Catastral para entregar a la D.G. del Catastro.-->
<!--Generado por chapulincatastral https://github.com/chapulincatastral/generador-gml/ -->
<gml:FeatureCollection xmlns:gml=\"http://www.opengis.net/gml/3.2\" xmlns:gmd=\"http://www.isotc211.org/2005/gmd\" xmlns:ogc=\"http://www.opengis.net/ogc\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:cp=\"urn:x-inspire:specification:gmlas:CadastralParcels:3.0\" xmlns:base=\"urn:x-inspire:specification:gmlas:BaseTypes:3.2\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xsi:schemaLocation=\"urn:x-inspire:specification:gmlas:CadastralParcels:3.0 http://inspire.ec.europa.eu/schemas/cp/3.0/CadastralParcels.xsd\" gml:id=\"ES.LOCAL.CP.%CODIGOPARCELA%\">
<gml:featureMember>
<cp:CadastralParcel gml:id=\"ES.%TIPO_DE_PARCELA%.CP.%CODIGOPARCELA%\">
<!-- Superficie de la parcela en metros cuadrados. Tiene que coincidir con la calculada con las coordenadas.-->
<cp:areaValue uom=\"m2\">AREAPARCELA</cp:areaValue>
<cp:beginLifespanVersion xsi:nil=\"true\" nilReason=\"other:unpopulated\"></cp:beginLifespanVersion>
<!-- Geometria en formato GML -->
<cp:geometry>
<!-- srs Name codigo del sistema de referencia en el que se dan las coordenadas, que debe coincidir con el de la cartografia catastral -->
<!-- el sistema de referencia de la cartografÃa catastral varÃa según provincia, siendo accesible desde la consulta de cartografÃa en Sede -->
<gml:MultiSurface gml:id=\"MultiSurface_ES.%TIPO_DE_PARCELA%.CP.%CODIGOPARCELA%\" srsName=\"urn:ogc:def:crs:EPSG::258%HUSOPARCELA%\">
<gml:surfaceMember>
<gml:Surface gml:id=\"Surface_ES.%TIPO_DE_PARCELA%.CP.%CODIGOPARCELA%\" srsName=\"urn:ogc:def:crs:EPSG::258%HUSOPARCELA%\">
<gml:patches>
<gml:PolygonPatch>")
(setq plantilla2 "
<gml:exterior>
<gml:LinearRing>
<!-- Lista de coordenadas separadas por espacios o en lineas diferentes -->
<gml:posList srsDimension=\"2\">%COOR_PARCELA%</gml:posList>
</gml:LinearRing>
</gml:exterior>")
(setq plantilla3 "
<gml:interior>
<gml:LinearRing>
<!-- Lista de coordenadas separadas por espacios o en lineas diferentes -->
<gml:posList srsDimension=\"2\">%COOR_ISLA%</gml:posList>
</gml:LinearRing>
</gml:interior>")
(setq plantilla4 "
</gml:PolygonPatch>
</gml:patches>
</gml:Surface>
</gml:surfaceMember>
</gml:MultiSurface>
</cp:geometry>
<cp:inspireId>
<base:Identifier>
<!-- Identificativo local de la parcela. Solo puede tener letras y numeros. Se recomienda (pero no es necesario) poner siempre un digito de control, por ejemplo utilizando el algoritmo del NIF.-->
<base:localId>%CODIGOPARCELA%</base:localId>
<base:namespace>ES.%TIPO_DE_PARCELA%.CP</base:namespace>
</base:Identifier>
</cp:inspireId>
<cp:label/>
<!--Siempre en blanco, ya que todavia no ha sido dada de alta en las bases de datos catastrales.-->
<cp:nationalCadastralReference/>
</cp:CadastralParcel>
</gml:featureMember>
<!-- Si se desea entregar varias parcelas en un mismo fichero, se pondra un nuevo featureMember para cada parcela -->
</gml:FeatureCollection>
")
); progn Plantilla GML de Parcela
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn ; Plantillas de fichero .html Informe de Edificio
(setq html_edifi "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/REC-html40/loose.dtd\">
<html>
<head>
<title>Informe de Coord. Georrefe. de los Vértices de la Edificación</title>
<meta name=\"Description\" content=\"INFORME COORDENADAS GEORREFERENCIADAS DE LOS VÉRTICES DE LA EDIFICACIÓN\">
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">
<meta name=\"Author\" content=\"ChapulinCatastral\">
<style type=\"text/css\">
table#01 {
table-layout: fixed;
width: 900px;
}
th {
text-align: right;
width: 80px;
font-size: 10px;
}
.th_n {
text-align: right;
width: 25px;
font-size: 10px;
}
td {
text-align: right;
width: 80px;
font-size: 10px;
}
.td_n {
text-align: right;
width: 25px;
font-size: 10px;
}
h1 {
font-family: verdana;
text-align: left;
font-size: 22px;
}
.p_r {
font-family: verdana;
font-size: 16px;
}
.p_d {
font-size: 16px;
text-align: right;
}
p {
font-family: verdana;
font-size: 12px;
text-align: left;
}
.p_f {
font-family: verdana;
font-size: 12px;
text-align: left;
text-indent: 200px;
}
</style>
</head>
<body>
<h1>INFORME DE COORDENADAS GEORREFERENCIADAS DE LOS VÉRTICES DE LA EDIFICACIÓN </h1>
<p class=\"p_d\"> Hoja 1/1</p>
<p class=\"p_r\">REFERENCIA DEL EDIFICIO: %REFERENCIA_EDIFICIO%</p>
<p>Sistema de referencia ETRS89, coordenadas U.T.M. huso %HUSO% [%SISTEMA_REFERENCIA%]</p>
<p>Escala máxima de representación de estas coordenadas: 1:%MAX_REPRESENTACION%</p>
<p>Total: %NUM_VERTICES% vértices.</p>
%TABLA%
<p class=\"p_f\">%LUGAR_Y_FECHA%</p>
<p class=\"p_f\">%ANTEFIRMA%</p>
<p> </p>
<p> </p>
<p class=\"p_f\">%POSFIRMA%</p>
</body>
</html>")
(setq html_edifi_tabla " <table id=\"t01\">
<tr>
<th class=\"th_n\">Nº</th>
<th>X</th>
<th>Y</th>
<th class=\"th_n\"> </th>
<th class=\"th_n\">Nº</th>
<th>X</th>
<th>Y</th>
<th class=\"th_n\"> </th>
<th class=\"th_n\">Nº</th>
<th>X</th>
<th>Y</th>
<th class=\"th_n\"> </th>
<th class=\"th_n\">Nº</th>
<th>X</th>
<th>Y</th>
%FILA_TABLA%
</table>")
(setq html_edifi_fila_tabla " <tr>
<td class=\"td_n\">%NUM_VERTICE_1%</td>
<td>%COOR_X_1%</td>
<td>%COOR_Y_1%</td>
<td class=\"td_n\">%NUM_VERTICE_2%</td>
<td>%COOR_X_2%</td>
<td>%COOR_Y_2%</td>
<td class=\"td_n\">%NUM_VERTICE_3%</td>
<td>%COOR_X_3%</td>
<td>%COOR_Y_3%</td>
<td class=\"td_n\">%NUM_VERTICE_4%</td>
<td>%COOR_X_4%</td>
<td>%COOR_Y_4%</td>
</tr>")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn ; Funciones Comunes
(if (=(substr(getvar "ACADVER")1 2)"14")
(defun rtoc ( n p / foo d l ); convierte el numero 'n' en string; añade una ',' cada tres posiciones enteras y usa 'p' posiciones decimales
(defun foo ( l n )
(if (< (strlen l) 2)
l
(if (= "." (substr l 2 1))
(strcat (substr l 1 1) "," (substr l 3))
(if (zerop (rem n 3))
(strcat (substr l 1 1) "." (foo (substr l 2) (1+ n)))
(strcat (substr l 1 1) (foo (substr l 2) (1+ n)))
)
)
)
)
(setq l (rtos (abs n) 2 p))
(strcat (if (minusp n) "-" "")
(foo l (- 3 (rem (fix (/ (log (abs n)) (log 10))) 3)))
)
); defun rtoc
(defun rtoc ( n p / foo d l ); convierte el numero 'n' en string; añade una ',' cada tres posiciones enteras y usa 'p' posiciones decimales
(defun foo ( l n )
(if (not (cadr l))
l
(if (= 46 (cadr l))
(vl-list* (car l) 44 (cddr l))
(if (zerop (rem n 3))
(vl-list* (car l) 46 (foo (cdr l) (1+ n)))
(cons (car l) (foo (cdr l) (1+ n)))
)
)
)
)
(setq d (getvar 'dimzin))
(setvar 'dimzin 0)
(setq l (vl-string->list (rtos (abs n) 2 p)))
(setvar 'dimzin d)
(vl-list->string
(append (if (minusp n) '(45))
(foo l (- 3 (rem (fix (/ (log (abs n)) (log 10))) 3)))
)
)
); defun rtoc
); if
(defun split (lst len opt / ls l i) ; opt, T= by division or nil=by length
(setq i 1 l '() len (if opt (/ (length lst) len) len))
(while lst
(setq l (append l (list(car lst))))
(if
(zerop (rem i len))
(setq ls (cons l ls) l nil)
)
(setq i (1+ i) lst (cdr lst))
) ;_ end of foreach
(if l
(append (reverse ls) (list l))
(reverse ls)
) ;_ end of if
) ;_ end of defun
(defun str-pos(str c / i l ls lc)
(setq i 1)
(setq ls(strlen str))
(setq lc(strlen c))
(setq l(1+(- ls lc)))
(while(and(<= i l)(/=(substr str i lc)c))
(setq i(1+ i))
)
(if(<= i l)i)
)
(defun es_digito (char)
(or (= char "0")
(= char "1")
(= char "2")
(= char "3")
(= char "4")
(= char "5")
(= char "6")
(= char "7")
(= char "8")
(= char "9"))
);defun es_digito
(defun es_referencia (cadena)
(and (= (strlen cadena) 14)
(es_digito (substr cadena 1 1)))
);defun es_referencia
(defun str-count(str tok / res)
(setq res 0)
(while(>(strlen str)0)
(if(=(str-pos str tok)1)
(progn
(setq res(1+ res))
(setq str(substr str(1+(strlen tok))))
)
(progn
(setq str(substr str 2))
)
)
)
res
);defun str-count
(defun real_ingles (cadena)
(vl-string-subst "." "," cadena)
)
(defun real_espanyol(cadena / tmp)
(if (and (> (strlen cadena) 6) (/= (str-pos cadena ".") 0) (= 2 (-(strlen cadena) (str-pos cadena ".")) ))
(progn
(setq tmp (vl-string-subst "," "." cadena))
(if (> (strlen cadena) 9)
(strcat (substr tmp 1 (- (strlen tmp) 9)) "." (substr tmp (- (strlen tmp) 8) 3) "." (substr tmp (- (strlen tmp) 5)))
(strcat (substr tmp 1 (- (strlen tmp) 6)) "." (substr tmp (- (strlen tmp) 5)))
)
)
(if (/= (str-pos cadena ".") 0)
(vl-string-subst "," "." cadena)
cadena
)
)
)
(defun es_real_positivo (cadena / i )
(setq i 1)
(if (= (substr cadena 1 1) "+") (setq cadena (substr cadena 2)))
(while (and (<= i (strlen cadena))
(or (es_digito (substr cadena i 1))
(= (substr cadena i 1) ",")
(= (substr cadena i 1) ".")))
(setq i (+ i 1))
)
(and (> i (strlen cadena))
(and (< (+ (str-count cadena ",") (str-count cadena ".")) 2))
(> (atof (vl-string-subst "." "," cadena)) 0.0))
);defun es_real_positivo
(defun es_entero_positivo (cadena / i )
(setq i 1)
(if (= (substr cadena 1 1) "+") (setq cadena (substr cadena 2)))
(while (and (<= i (strlen cadena))
(es_digito (substr cadena i 1)))
(setq i (+ i 1))
)
(and (> i (strlen cadena)) (> (atoi cadena) 0))
);defun es_entero_positivo
(defun es_fecha (cadena)
(and (<= (strlen cadena) 10)
(>= (strlen cadena) 8)
(= (str-count cadena "-") 2)
(setq posicion1 (str-pos cadena "-"))
(setq posicion2 (str-pos (substr cadena (+ posicion1 1)) "-" ))
(setq posicion2 (+ posicion1 posicion2 ))
(es_entero_positivo (substr cadena 1 (- posicion1 1)))
(es_entero_positivo (substr cadena (+ posicion1 1) (- posicion2 posicion1 1)))
(es_entero_positivo (substr cadena (+ posicion2 1)(- (strlen cadena) posicion2 )))
(<= (atoi (substr cadena 1 (- posicion1 1))) 31)
(<= (atoi (substr cadena (+ posicion1 1) (- posicion2 posicion1 1))) 12)
(<= (atoi (substr cadena (+ posicion2 1)(- (strlen cadena) posicion2 ))) 2050)
(> (atoi (substr cadena (+ posicion2 1)(- (strlen cadena) posicion2 ))) 1900)
)
);defun es_fecha
(defun fecha_en_ingles (fecha_txt)
(if (= (str-pos fecha_txt "-") 2) (setq fecha_txt (strcat "0" fecha_txt)))
(if (= (strlen fecha_txt) 9) (setq fecha_txt (strcat (substr fecha_txt 1 3) "0" (substr fecha_txt 4))))
(setq posicion1 (str-pos fecha_txt "-"))
(setq posicion2 (str-pos (substr fecha_txt (+ posicion1 1)) "-" ))
(setq posicion2 (+ posicion1 posicion2 ))
(strcat
(substr fecha_txt (+ posicion2 1)(- (strlen fecha_txt) posicion2 ))
"-"
(substr fecha_txt (+ posicion1 1) (- posicion2 posicion1 1))
"-"
(substr fecha_txt 1 (- posicion1 1)) )
)
(defun coordenada_toasc2 (una_coordenada)
(strcat (rtos (car una_coordenada) 2 2) " " (rtos (cadr una_coordenada) 2 2) " ")
); defun coordenada_toasc2
(defun proporcionar_fichero_escritura ( extension / mensaje directorio_correcto nombre_fichero_escritura fichero_prueba_escritura)
(cond
( (= extension "gml")(setq mensaje "Guardar fichero GML Edificio como... ")
)
( (= extension "html")(setq mensaje "Guardar fichero HTML Informe Edificio como ... ")
)
( (= extension "txt")(setq mensaje "Guardar fichero TXT descripción de GML Parcela como ... ")
)
(t (setq mensaje "Guardar fichero como ... ")
)
)
(setq directorio_correcto "F")
(while (= directorio_correcto "F")
(setq nombre_fichero_escritura
(getfiled mensaje
(if (=(substr(getvar "ACADVER")1 2)"14")
"C:\\"
(getvar 'MYDOCUMENTSPREFIX))
extension 1))
; Comprobar permisos de escritura
(if (null (setq fichero_prueba_escritura (open nombre_fichero_escritura "w")))
(progn
(alert "Error: No se puede escribir en el directorio seleccionado, elige otro.")
;(exit)
); then
(progn
(setq directorio_correcto "T")
(close fichero_prueba_escritura)
;;(vl-file-delete nombre_fichero_escritura); borramos el fichero de prueba
); else
);if
);while
nombre_fichero_escritura
); defun proporcionar_fichero_escritura
); progn Funciones Comunes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn ; Funciones Lista ChapulinCatastral
;;;; Lista Chapulin -> (recinto recinto ...)
;;;; recinto -> (NOMBRE_RECINTO AREA perimetro islas)
;;;; perimetro -> ((coordenadaX coordenadaY) (coordenadaX coordenadaY) ...)
;;;; islas -> (isla isla ...)
;;;; isla -> (AREA perimetro)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq *nombres_de_parcela_predefinidos* '("1A" "1B" "1C" "1D" "1E" "1F" "1G" "1H" "1J" "1K" "1L" "1M" "1N" "1P" "1R" "1S" "1T" "1T" "1U" "1V" "1X" "1Y" "1Z"))
(setq *lista_variales_Xdefecto* '("lista_huso_ind" "precision_txt" "lugar_y_fecha_txt" "antefirma_txt" "posfirma_txt"))
(setq *lista_valores_Xdefecto* '("2" "0,1" "" "" ""))
(setq *max_filas_tabla_informe_edifio* 40)
(setq *num_columnas_tabla_informe_edifio* 4)
(defun put_valores_Xdefecto()
(mapcar '(lambda(x) (setenv x (eval (read x))) ) *lista_variales_Xdefecto*)
)
(defun get_valores_Xdefecto()
(mapcar '(lambda(x) (if (null (set (read x) (getenv x)))(set (read x) (nth (vl-position x *lista_variales_Xdefecto*) *lista_valores_Xdefecto* )))) *lista_variales_Xdefecto*)
)
(defun tiene_arcos (polilyne / i lon )
(setq arcos (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 42 (car x))) polilyne)))
(setq lon (length arcos))
(setq i 0)
(while (and (car arcos) (=(car arcos) 0.0))(setq arcos (cdr arcos))(setq i (+ i 1)))
(< i lon )
); defun tiene_arcos
(defun analiza_entidad_seleccionada (nombre_una_entidad / lista_datos_entidad perimetro_entidad objetos_interiores NOMBRE_RECINTO AREA_R islas)
(setq lista_datos_entidad (entget nombre_una_entidad))
(if (tiene_arcos lista_datos_entidad)
(progn
(alert (strcat "ERROR\n Un recinto:\"" "exterior" "\"contiene arcos; Por favor conviertalo en sucesión de líneas rectas"))
(exit)))
(setq perimetro_entidad (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) lista_datos_entidad)))
;;(setq objetos (ssget "_WP" perimetro_entidad))
(if (setq objetos_interiores (ssget "_WP" perimetro_entidad))
(progn
(setq NOMBRE_RECINTO (analiza_entidad_interior_texto objetos_interiores))
(setq islas (analiza_entidad_interior_recintos objetos_interiores))
)
)
(command "_AREA" "_E" nombre_una_entidad)
(setq AREA_R (getvar "AREA") )
(if (null (car NOMBRE_RECINTO))
(progn
(setq NOMBRE_RECINTO (list (car *nombres_de_parcela_predefinidos*)))
(setq *nombres_de_parcela_predefinidos* (cdr *nombres_de_parcela_predefinidos*))
)
(if (> (str-count (car NOMBRE_RECINTO) " ") 0)
(progn
(alert (strcat "ERROR: Nombre Parcela \"" (car NOMBRE_RECINTO) "\", contiene espacios en blanco"))
(exit)
)
)
)
(list (car NOMBRE_RECINTO) AREA_R perimetro_entidad islas)
;; (caar islas) ; primera superficie; (caadr islas) ; segunda ; (caaddr islas) ; tercera
) ; defun analiza_entidad_seleccionada
(defun get_nombre_parcela (recinto)
(if (null (car recinto))
(progn
(setq *nombres_de_parcela_predefinidos* (cdr *nombres_de_parcela_predefinidos*))
(car *nombres_de_parcela_predefinidos*)
)
(if (not (str-pos (car recinto) " "))
(car recinto)
(progn
(alert (strcat "ERROR: Nombre Parcela \"" (car recinto) "\", contiene espacios en blanco"))
(exit)
)
)
)
);defun get_nombre_parcela
(defun get_tipo_parcela (recinto)
(if (and (car recinto) (es_referencia (car recinto)))
"SDGC"
"LOCAL")
);defun get_tipo_parcela
(defun get_area (recinto)
(- (cadr recinto) (get_area_islas recinto))
);defun get_area
(defun get_recinto_exterior_txt (recinto)
(strcat (apply 'strcat (mapcar 'coordenada_toasc2 (caddr recinto)))
(coordenada_toasc2 (car (caddr recinto))))
);defun get_recinto_exterior_txt
(defun get_recinto_interior_txt (recinto)
(strcat (apply 'strcat (mapcar 'coordenada_toasc2 (cadr recinto)))
(coordenada_toasc2 (car (cadr recinto))))
);defun get_recinto_interior_txt
(defun get_islas (recinto)
(setq islas (cadddr recinto))
);defun get_islas
(defun get_area_islas (recinto / islas area_islas)
;;(setq recinto (cadr lista_chapulin))
(setq islas (get_islas recinto))
(setq area_islas 0)
(while (caar islas)
(setq area_islas (+ (caar islas) area_islas))
(setq islas (cdr islas)))
area_islas
);defun get_area_islas
(defun analiza_entidad_interior_texto (objetos / numero_entidades numero_entidad encontrado nombre_entidad lista_datos_entidad)
(setq numero_entidades (sslength objetos))
(setq numero_entidad 0 )
(setq encontrado -1)
(while (and (< numero_entidad numero_entidades) (= encontrado -1))
(setq nombre_entidad (ssname objetos numero_entidad))
(setq lista_datos_entidad (entget nombre_entidad))
(if (or (= (cdadr lista_datos_entidad) "TEXT") (= (cdadr lista_datos_entidad) "MTEXT"))
(setq encontrado numero_entidad)
(setq numero_entidad (+ 1 numero_entidad))
)
)
(if (> encontrado -1) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 1 (car x))) lista_datos_entidad)))
); defun analiza_entidad_interior_texto
(defun analiza_entidad_interior_recintos (objetos / numero_entidades numero_entidad nombre_entidad lista_datos_entidad recintos_interiores AREA_R)
(setq numero_entidades (sslength objetos))
(setq numero_entidad 0 )
(setq recintos_interiores '())
(repeat numero_entidades
(setq nombre_entidad (ssname objetos numero_entidad))
(setq lista_datos_entidad (entget nombre_entidad))
(setq numero_entidad (+ 1 numero_entidad))
;;'((0 . "POLYLINE,LWPOLYLINE") (70 . 1))
(if (and (or (= (cdadr lista_datos_entidad) "LWPOLYLINE")
(= (cdadr lista_datos_entidad) "POLYLINE"))
(= (cdar (vl-remove-if-not '(lambda (x) (= 70 (car x)) ) lista_datos_entidad)) 1))
(if (tiene_arcos lista_datos_entidad)
(progn ; then
(alert (strcat "ERROR\n Un recinto:\"" "interior" "\"contiene arcos; Por favor conviertalo en sucesión de líneas rectas"))
(exit))
(progn
(command "_AREA" "_E" nombre_entidad)
(setq AREA_R (getvar "AREA") )
(setq recintos_interiores (cons (list AREA_R (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) lista_datos_entidad))) recintos_interiores))
))
)
)
recintos_interiores
); defun analiza_entidad_interior_recintos
); progn ; Funciones Lista ChapulinCatastral
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn ; Funciones GML de Edificio
(defun htmlentities (cadena / tmp1 tmp2)
(setq entities '("á" "é" "í" "ó" "ú" "Á" "É" "Í" "Ó" "Ú" "à" "è" "ì" "ò" "ù" "À" "È" "Ì" "Ò" "Ù" "ñ" "Ñ" "ç" "Ç" "º" "ª" "ü" "Ü" "ï" "Ï"))
(setq html_entities '("á" "é" "í" "ó" "ú"
"Á" "É" "Í" "Ó" "Ú"
"à" "è" "ì" "ò" "ù"
"À" "È" "Ì" "Ò" "Ù"
"ñ" "Ñ" "ç" "Ç" "º" "ª"
"ü" "Ü" "ï" "Ï" ))
(setq tmp cadena)
(setq tmp2 "")
(while (> (strlen tmp) 0)
(setq tmp2 (strcat tmp2
(if (vl-position (substr tmp 1 1) entities)
(nth (vl-position (substr tmp 1 1) entities) html_entities)
(substr tmp 1 1)
)
)
)
(setq tmp (substr tmp 2))
)
tmp2
);defun htmlentities
(defun genera_informe_html_edificio (nombre_fichero lista_chapulin / fichero_escritura)
(if (null (setq fichero_escritura (open nombre_fichero "w")))
(progn
(alert (strcat "ERROR; el Informe de esquinas de edificio: \""
nombre_fichero
"\"\n no ha podido ser generado"))
(exit)
)
(progn
(princ (genera_informe_html_edificio_html lista_chapulin) fichero_escritura)
(close fichero_escritura)
(alert (strcat "Informe de esquinas de edificio: \""
nombre_fichero
"\"\n correctamente generado"))
)
)
); defun genera_informe_html_edificio
(defun genera_informe_html_edificio_html (lista_chapulin / vertices max_representacion)
;;(while (car lista_chapulin) ; empezamos con un solo recinto
(setq vertices (caddar lista_chapulin))
(setq max_representacion (rtoc (* (atof (real_ingles precision_txt)) 15000) 0))
(vl-string-subst referencia_edificio_txt "%REFERENCIA_EDIFICIO%"
(vl-string-subst (substr item_huso 5 2) "%HUSO%"
(vl-string-subst item_huso "%SISTEMA_REFERENCIA%"
(vl-string-subst max_representacion "%MAX_REPRESENTACION%"
(vl-string-subst (itoa (vl-list-length vertices)) "%NUM_VERTICES%"
(vl-string-subst (genera_informe_html_edificio_html_tabla vertices) "%TABLA%"
(htmlentities
(vl-string-subst lugar_y_fecha_txt "%LUGAR_Y_FECHA%"
(vl-string-subst antefirma_txt "%ANTEFIRMA%"
(vl-string-subst posfirma_txt "%POSFIRMA%" html_edifi))))))))))
); defun genera_informe_html_edificio_html
(defun genera_informe_html_edificio_html_tabla ( recinto )
(vl-string-subst (genera_informe_html_edificio_html_fila_tabla recinto)
"%FILA_TABLA%"
html_edifi_tabla)
); defun genera_informe_html_edificio_html_tabla
(defun genera_informe_html_edificio_html_fila_tabla ( recinto / num_vertice num_vertices html_tabla coordenadas num_vertices)
(defun coorX_vertice_txt (lista_coordenadas vertice )
(if (> vertice num_vertices)
" "
(rtoc (car (nth (- vertice 1) lista_coordenadas)) 2 ))
)
(defun coorY_vertice_txt (lista_coordenadas vertice )
(if (> vertice num_vertices)
" "
(real_espanyol(rtos (cadr (nth (- vertice 1) lista_coordenadas)) 2 2)))
)
(defun vertice_tx (vertice)
(if (> vertice num_vertices)
" "
(itoa vertice))
)
(setq num_vertice 1)
(setq num_vertices (vl-list-length recinto) )
(setq html_tabla "")
(if (> num_vertices (* *max_filas_tabla_informe_edifio* *num_columnas_tabla_informe_edifio*))
(progn
(alert (strcat "ERROR: demasiados vértices en el recinto; número de vértices:"
(itoa (vl-list-length coordenadas))
". Número máximo de vértices permitidos: "
(itoa (* *max_filas_tabla_informe_edifio* *num_columnas_tabla_informe_edifio*))
)
)
(exit)
)
)
(repeat (min num_vertices *max_filas_tabla_informe_edifio*)
(setq html_tabla (strcat html_tabla "\n"
" <tr>"
" <td class=\"td_n\">"(vertice_tx (+ num_vertice (* 0 *max_filas_tabla_informe_edifio*)))"</td>"
" <td>"(coorX_vertice_txt recinto (+ num_vertice (* 0 *max_filas_tabla_informe_edifio*)))"</td>"
" <td>"(coorY_vertice_txt recinto (+ num_vertice (* 0 *max_filas_tabla_informe_edifio*)))"</td>"
" <td class=\"td_n\"> </td>"
" <td class=\"td_n\">"(vertice_tx (+ num_vertice (* 1 *max_filas_tabla_informe_edifio*)))"</td>"
" <td>"(coorX_vertice_txt recinto (+ num_vertice (* 1 *max_filas_tabla_informe_edifio*)))"</td>"
" <td>"(coorY_vertice_txt recinto (+ num_vertice (* 1 *max_filas_tabla_informe_edifio*)))"</td>"
" <td class=\"td_n\"> </td>"
" <td class=\"td_n\">"(vertice_tx (+ num_vertice (* 2 *max_filas_tabla_informe_edifio*)))"</td>"
" <td>"(coorX_vertice_txt recinto (+ num_vertice (* 2 *max_filas_tabla_informe_edifio*)))"</td>"
" <td>"(coorY_vertice_txt recinto (+ num_vertice (* 2 *max_filas_tabla_informe_edifio*)))"</td>"
" <td class=\"td_n\"> </td>"
" <td class=\"td_n\">"(vertice_tx (+ num_vertice (* 3 *max_filas_tabla_informe_edifio*)))"</td>"
" <td>"(coorX_vertice_txt recinto (+ num_vertice (* 3 *max_filas_tabla_informe_edifio*)))"</td>"
" <td>"(coorY_vertice_txt recinto (+ num_vertice (* 3 *max_filas_tabla_informe_edifio*)))"</td>"
" </tr>"))
(setq num_vertice (+ num_vertice 1))
)
html_tabla
); defun genera_informe_html_edificio_html_fila_tabla
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun copy_paste_registradores (coordenadas / lon i coor_copy_paste espacios )
(setq lon (strlen coordenadas))
(setq coor_copy_paste "")
(setq i 1)
(setq espacios 0)
(while (< i lon)
(setq coor_copy_paste (strcat coor_copy_paste
(if (= (substr coordenadas i 1) " ")
(progn
(setq espacios (+ espacios 1))
(if (= (rem espacios 2) 0)
"\n"
" "
)
)
(substr coordenadas i 1)
)
)
)
(setq i (+ i 1))
)
coor_copy_paste
); defun copy_paste_registradores
(defun genera_gml_edificio_txt (lista_chapulin / PolygonPatches)
(setq PolygonPatches "")
(while (car lista_chapulin)
(setq PolygonPatches (strcat PolygonPatches
(vl-string-subst (copy_paste_registradores (get_recinto_exterior_txt (car lista_chapulin)))
"%COORDENADAS%" fichero_gml_PolygonPatch)))
(setq lista_chapulin (cdr lista_chapulin))
)
(strcat
(if (= obra_txt "obra_acabada" )
(strcat
(vl-string-subst "functional" "%OBRA%" fichero_gml_1)
(vl-string-subst (fecha_en_ingles fecha_fin_txt) "%FECHA-FIN%"
(vl-string-subst (fecha_en_ingles fecha_inicio_txt) "%FECHA-INICIO%" fichero_gml_2)))
(vl-string-subst "underConstruction" "%OBRA%" fichero_gml_1))
(vl-string-subst referencia_edificio_txt "%REFERENCIA-PARCELA%"
(vl-string-subst item_huso "%HUSO%" fichero_gml_3))
PolygonPatches
(vl-string-subst (real_ingles precision_txt) "%PRECISION%" fichero_gml_4)
(if (/= item_uso "") (vl-string-subst item_uso "%USO%" fichero_gml_5) "")
(vl-string-subst inmuebles_txt "%INMUEBLES%"
(vl-string-subst viviendas_txt "%VIVIENDAS%"
(vl-string-subst plantas_txt "%PLANTAS%"
(vl-string-subst superficie_txt "%SUPERFICIE%" fichero_gml_6)))))
);defun genera_gml_txt
(defun msg_error ()
(setq texto "")
(if (and (= obra_txt "obra_acabada") (not (es_fecha fecha_inicio_txt)))
(setq texto (strcat texto "\nERROR.\n El formato de fecha inicio obras:\"" fecha_inicio_txt "\" no es correcto\n"))
)
(if (and (= obra_txt "obra_acabada") (not (es_fecha fecha_fin_txt)))
(setq texto (strcat texto "\nERROR.\n El formato de fecha fin obras:\"" fecha_fin_txt "\" no es correcto\n"))
)
(if (= referencia_edificio_txt "")
(setq texto (strcat texto
"\nERROR.\n El identificador de la parcela no puede estar en blanco\n")))
(if (= precision_txt "")
(setq texto (strcat texto "\nERROR.\n La precisión de las coord. no puede dejarse en blanco\n"))
(if (not (es_real_positivo precision_txt))
(setq texto (strcat texto "\nERROR.\n La precisión de las coord.:\""
precision_txt "\", no es un número real positivo\n"))))
(if (= inmuebles_txt "")
(setq texto (strcat texto "\nERROR.\n El número de inmuebles no puede dejarse en blanco\n"))
(if (not (es_entero_positivo inmuebles_txt))
(setq texto (strcat texto "\nERROR.\n El número de inmuebles:\""
inmuebles_txt "\", no es un número entero positivo\n"))))
(if (= viviendas_txt "")
(setq texto (strcat texto "\nERROR.\n El número de viviendas no puede dejarse en blanco\n"))
(if (not (or (es_entero_positivo viviendas_txt) (= "0" viviendas_txt)))
(setq texto (strcat texto "\nERROR.\n El número de viviendas:\""
viviendas_txt "\", no es un número entero positivo\n"))))
(if (= plantas_txt "")
(setq texto (strcat texto "\nERROR.\n El número de plantas no puede dejarse en blanco\n"))
(if (not (es_entero_positivo plantas_txt))
(setq texto (strcat texto "\nERROR.\n El número de plantas:\""
plantas_txt "\", no es un número entero positivo\n"))))
(if (= superficie_txt "")
(setq texto (strcat texto "\nERROR.\n La superficie no puede dejarse en blanco\n"))
(if (not (es_entero_positivo superficie_txt))
(setq texto (strcat texto "\nERROR.\n El valor de la superficie:\""
superficie_txt "\", no es un número entero positivo\n"))))
(if (and (es_entero_positivo inmuebles_txt)
(es_entero_positivo viviendas_txt)
(> (atoi viviendas_txt) (atoi inmuebles_txt)))
(setq texto (strcat texto "\nERROR.\n El número de inmuebles no puede ser menor que el de viviendas\n")))
texto
)
(defun formulario_es_correcto ()
(and
(or (= obra_txt "obra_sin_acabar")
(and (= obra_txt "obra_acabada")
(es_fecha fecha_inicio_txt)
(es_fecha fecha_fin_txt)))
(/= referencia_edificio_txt "")
(es_real_positivo precision_txt)
(es_entero_positivo inmuebles_txt)
(or (es_entero_positivo viviendas_txt) (= "0" viviendas_txt))
(es_entero_positivo plantas_txt)
(es_entero_positivo superficie_txt)
(<= (atoi viviendas_txt) (atoi inmuebles_txt))
)
); defun formulario_es_correcto
(defun genera_fichero_gml_edificio (nombre_fichero lista_chapulin/fichero_escritura)
(setq fichero_escritura (open nombre_fichero "w"))
(princ (genera_gml_edificio_txt lista_chapulin) fichero_escritura)
(close fichero_escritura)
(alert (strcat "fichero de GML de edificio: \""
nombre_fichero
"\"\n correctamente generado"))
); defun genera_fichero_gml_edificio
(defun saveVars()
(setq obra_txt (get_tile "obra"))
(setq fecha_inicio_txt (get_tile "fecha_inicio"))
(setq fecha_fin_txt (get_tile "fecha_fin"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq referencia_edificio_txt (get_tile "referencia_edificio"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq lista_huso_ind (get_tile "lista_huso"))
(if(= lista_huso_ind "")
(setq item_huso nil)
(setq item_huso (nth (atoi lista_huso_ind) lista_huso))
)
(setq precision_txt (get_tile "precision"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq lista_uso_ind (get_tile "lista_uso"))
(if(= lista_uso_ind "")
(setq item_uso nil)
(setq item_uso (nth (atoi lista_uso_ind) lista_uso))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq inmuebles_txt (get_tile "inmuebles"))
(setq viviendas_txt (get_tile "viviendas"))
(setq plantas_txt (get_tile "plantas"))
(setq superficie_txt (get_tile "superficie"))
(setq lugar_y_fecha_txt (get_tile "lugar_y_fecha"))
(setq antefirma_txt (get_tile "antefirma"))
(setq posfirma_txt (get_tile "posfirma"))
);defun saveVars
(defun C:gmle()
(setq lista_chapulin nil)
(setq cancelado nil)
(setq formulario_correcto nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Solicitamos seleccionar los recintos del edificio
(alert "Seleccione los perímetros exteriores del edificio.\n\n NOTA: Sólo se permite seleccionar polílineas previamente cerradas!!")
;; Solo se permite seleccionar polilineas previamente cerradas
(setq recinto_parcela (ssget '((0 . "POLYLINE,LWPOLYLINE") (70 . 1))))
;; generacion de la lista chapulin a partir de los recintos seleccionados
(setq numero_entidades_recinto (sslength recinto_parcela))
(alert (strcat "Número de recintos seleccionados: " (itoa numero_entidades_recinto)))
(setq numero_entidad 0 )
(repeat numero_entidades_recinto
(setq lista_chapulin (cons (analiza_entidad_seleccionada (ssname recinto_parcela numero_entidad)) lista_chapulin)
numero_entidad (+ 1 numero_entidad)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn ; poner las variales txt a los valores por defecto del formulario
(setq obra_txt "obra_sin_acabar")
(setq fecha_inicio_txt "DD-MM-AAAA")
(setq fecha_fin_txt "")
;
;(setq referencia_edificio_txt "")
(setq referencia_edificio_txt (get_nombre_parcela(car lista_chapulin)))
(setq lista_huso(list "EPSG::32628" "EPSG::25829" "EPSG::25830" "EPSG::25831"))
;(setq lista_huso_ind "2") ;; por defecto uso30
;(setq precision_txt "")
;
(setq lista_uso(list "" "1_residential" "2_agriculture" "3_industrial" "4_commerceAndServices"))
(setq lista_uso_ind "0") ; por defecto uso destino en blanco
;
(setq inmuebles_txt "")
(setq viviendas_txt "")
(setq plantas_txt "")
(setq superficie_txt "")
(setq lugar_y_fecha_txt "")
;(setq antefirma_txt "")
;(setq posfirma_txt "")
(get_valores_Xdefecto)
); progn ; set variales txt a valores por defecto del formulario
;; Vamos con el formulario
(if(not(setq dcl_id (load_dialog "GML_EDIFICIO_4.dcl")))
(progn ; then => NO se ha encontrado el fichero .dcl con la definion del formulario
(alert "El fichero con la definición del formulario no se ha podido cargar,
añada nombre del directorio donde se encuentra el fichero GML_EDIFICIO.dcl
a la lista de directorios: \"Opciones de AutoCad\"->\"Ruta de búsqueda de archivo de soporte\"")
(exit)
);
(progn ; else => SI se ha encontrado el fichero .dcl con la definion del formulario
(while (and (not formulario_correcto) (not cancelado))
(if (not (new_dialog "GML_EDIFICIO" dcl_id))
(progn ; then => error en la definicion del formulario
(alert "\n\n La definición del formulario \"GML_EDIFICIO \"
no se encuentra en el fichero de definión \"GML_EDIFICIO_4.dcl\"")
(exit)
)
(progn ; else => definicion del formulario correcta
(progn ; Rellenamos los campos del formulario con los valores recuperados
; si es la primera vez del while, los valores son "los valores por defecto"
(action_tile "cancel" "(done_dialog 1)")
(action_tile "help" "(saveVars)(done_dialog 3)")
(action_tile "accept" "(saveVars)(done_dialog 2)")
;; Valores por defecto del cuadro de dialogo
(set_tile "obra" obra_txt)
(set_tile "fecha_inicio" fecha_inicio_txt)
(set_tile "fecha_fin" fecha_fin_txt)
;
(set_tile "referencia_edificio" referencia_edificio_txt)
(start_list "lista_huso" 3)
(mapcar 'add_list lista_huso)
(end_list)
(set_tile "lista_huso" lista_huso_ind)
(set_tile "precision" precision_txt)
;
(start_list "lista_uso" 3)
(mapcar 'add_list lista_uso)
(end_list)
(set_tile "lista_uso" lista_uso_ind)
;
(set_tile "inmuebles" inmuebles_txt)
(set_tile "viviendas" viviendas_txt)
(set_tile "plantas" plantas_txt)
(set_tile "superficie" superficie_txt)
(set_tile "lugar_y_fecha" lugar_y_fecha_txt)
(set_tile "antefirma" antefirma_txt)
(set_tile "posfirma" posfirma_txt)
); Rellenamos los campos del formulario con los valores recuperados
; lanzamos el formulario y espamos por una accion
(setq ddiag(start_dialog))
(if (= ddiag 1) ; Ha pulsado cancelar.
(progn
;(princ "\n \n ...Ha pulsado cancelar. \n ")
(setq cancelado 'T))
(if (= ddiag 3) ; Ha pulsado ayuda.
(progn ; then
;(princ "\n \n ...Ha pulsado ayuda. \n ")
(alert "- Se recomienda entrar en la Sede Electrónica del Catastro para:
. Averiguar el sistema de referencia y huso de las coordenadas
. Descargar las coordenadas georreferenciadas del solar donde
se ubica el edificio.
- El perímetro del edificio ha de corresponderse o estar dentro de la parcela catastral georreferenciada, que previamente ha sido descargada.
- A la Cartografía Catastral se le supone una precisión de 0,1 metros.
- El perímetro del edificio se representa mediante una polilínea cerrada, compuesta por segmentos rectilíneos. No se admiten curvas.
- Si el edificio está compuesto por varios bloques independientes, tendremos varios perímetros.
- Si hay mas de un perímetro, no puede haber contactos entre ellos, por pequeño que sea."))
(if (= ddiag 2) ; Ha pulsado aceptar
(progn
;(princ "\n \n ...Ha Pulsado aceptar!")
(if (not (setq formulario_correcto (formulario_es_correcto)))
(progn
(alert "ATENCIÓN:\n\nSe han producido ERRORES\n\n al cumplimentar el formulario")
(alert (msg_error))))
)
;...no es ni uno ni dos ni tres => Ha pulsado aspa -> cerrar ventana. \n ")
(setq cancelado 'T)
) ; else if
) ; else if
) ; if Ha pulsado cancelar.
); else => definicion del formulario correcta
) ; if not (new_dialog)
); while (not formulario_correcto) Y (not cancelado)
(unload_dialog dcl_id)
(if (not cancelado)
(progn
(genera_fichero_gml_edificio (proporcionar_fichero_escritura "gml") lista_chapulin)
(genera_informe_html_edificio (proporcionar_fichero_escritura "html") lista_chapulin)
(put_valores_Xdefecto)
)
(alert "Generación de fichero GML de edificio cancelada")
)
); progn else
);if
(princ)
); defun C:gmle