CADlaberote/Corta.lsp at main · Oneirag/CADlaberote · GitHub

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
;;	Programilla para recortar una entidad señalando solo un punto


;;	-------------------------------------------------------------------------------
;;					FUNCION DE ERROR
;;	-------------------------------------------------------------------------------

(defun prog-err (s)
  (if (/= s "Función cancelada")
      (princ (strcat "\nError: nada que recortar "))	;; Debería cambiar funcion cancelada por s
  )
  (setq *error* olderr)
  (setq seleccion nil
  )
  (recupera-vars)
  (princ)
)

;;	-------------------------------------------------------------------------------
;;			Funcion para salvar las variables del sistema
;;	-------------------------------------------------------------------------------

(defun salva-vars (a)
  (setq MLST '())
  (repeat (length a)
    (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
    (setq a (cdr a))
  )
)


;;	-------------------------------------------------------------------------------
;;			Funcion para recuperar las variables salvadas del sistema
;;	-------------------------------------------------------------------------------

(defun recupera-vars ()
  (repeat (length MLST)
    (setvar (caar MLST) (cadar MLST))
    (setq MLST (cdr MLST))
  )
)


;;	-------------------------------------------------------------------------------
;; 					FUNCION PRINCIPAL
;;	-------------------------------------------------------------------------------


(defun corta (/  pt1 		seleccion	punto		dist
		   X		Y		sel
		)


;;-------LLamar a la nueva funcion de error)
	(setq olderr *error* *error* prog-err)

;;	Guardar variables del sistema
	(salva-vars '("cmdecho" "blipmode" "expert"
           "gridmode" "osmode" "thickness" "clayer"
	   "OFFSETDIST" )
	)

;;------Poner los valores que quiera en las variables del sistema------------
	(mapcar 'setvar
    		'("cmdecho" "blipmode" "expert" "gridmode"
      		"osmode" "thickness")
    		'(0 0 0 0 0 0)
 	 )


	;;Forma retorcida de obtener la entidad y el punto a la vez.
	;;Obtengo la entidad para ver que si señalo algo que no sea en una
	;;Entidad, no encuentre el punto

	(setq sel (entsel  "\nSeleccione punto a recortar"))

	(setq pt1 	(cadr sel))

;	(setq nombre 	(car sel))	ESTA LINEA QUEDA PARA OTRA VEZ POR SI LO NECESITO


;; Y ahora, bucle
	(While sel
		(progn

		;; Obtengo las coordenadas X e Y del tamaño en pixels de la pantalla

		(setq X (getvar "SCREENSIZE"))
		(setq Y	(cadr X) X (car X))

		;; Veo cual es el tamaño real de la pantalla en unidades de dibujo

		(setq X (* X (/ (getvar "VIEWSIZE") Y)))
		(setq Y (getvar "VIEWSIZE"))

		;; Y ahora, no hay más que centrarlo

		(setq punto (list X Y))
		(setq angulo (angle '(0 0) punto))
		(setq dist (/ (distance '(0 0) punto) 2 ))
		(setq X (polar (getvar "VIEWCTR") angulo dist))
		(setq Y (polar (getvar "VIEWCTR") (+ pi angulo) dist))

		(setq pt1 	(cadr sel))
		(setq seleccion (ssget "_c" X Y))
		(command "_trim" seleccion "" pt1 "")

		(setq sel (entsel  "\nSeleccione punto a recortar"))
		)
	)


(setq *error* olderr)		;;Volver a poner los errores en condiciones
(recupera-vars)
(prin1)				;Para que no salga ningun valor en la línea de comandos


)


;;	-------------------------------------------------------------------------------
;; 					MENSAJE HORTERA
;;	-------------------------------------------------------------------------------

(defun c:corta () (corta))
(defun c:xtrim () (corta))		;; Alias de la orden


(princ "\nFuncion para recortar cosas seleccionando solo un punto...cargada OK")
(princ)