forked from hemerfc/ag_autolisp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ag_base.lsp
250 lines (228 loc) · 7.1 KB
/
ag_base.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
;*******************************************************************************
; DTR
;degrees to radians function
(defun DTR (a)
(* PI (/ a 180.0))
)
;defun DTR
;*******************************************************************************
; RTD
;radians to degrees function
(defun RTD (a)
(if (not (eq a 0))
(* (/ PI a) 180)
0
)
)
;defun RTD
;*******************************************************************************
; DRAWPOLY
; funcao para desenhar pologonos fechados, aguarda uma lista de vertices
; retorna o e nome da entidade criada
(defun DrawPoly (lst color)
(entmakex (append (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length lst))
(cons 70 1)
(cons 62 color)
)
(mapcar (function (lambda (p) (cons 10 p))) lst)
)
)
)
;*******************************************************************************
;; List to String - Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item
(defun LM:lst->str (lst del / resp itm)
(setq resp (car lst))
(foreach itm (cdr lst) (setq resp (strcat resp del itm)))
resp
)
;*******************************************************************************
; CREATEBLKNAME
; Draw a rect with width and height parameters
(defun CreateBlkName (lista / bn)
;;"999_*"
;;(Setq bn (strcat "999_" (substr (rtos (getvar "cdate") 2 8) 10)))
(setq bn (LM:lst->str lista "_"))
)
;*******************************************************************************
; CREATEBLKNAME
; Draw a rect with width and height parameters
(defun InsertBlk (blockname InsPoint InsAngle)
;; Insert block framing marker
(entmake
(list
(cons 0 "INSERT") ;; Entity type
(cons 2 blockname)
(cons 8 "0")
(cons 10 InsPoint) ;; insert point
(cons 50 InsAngle) ;; rotation
(cons 70 0)
;(cons 66 1) ;; Attribute follow
)
)
; (entmake
; (list
; (cons 0 "ATTRIB") ;; Entity type
; (cons 1 Value) ;; Attrib Value
; (cons 2 "RTAG1") ;; Attrib Tag
; (cons 7 "1T14") ;; Textstyle
; (cons 8 "11T") ;; Layer
; (cons 10 InsPoint) ;; First alignment point
; (cons 11 InsPoint) ;; Second alignment point
; (cons 40 4.0) ;; Text height
; (cons 70 0) ;; Attribute flags: 8
; (cons 71 0) ;; Text generation flags
; (cons 72 1) ;; Horizontal text justification type
; (cons 74 2) ;; Vertical text justification type
; )
; )
(entmake
(list
(cons 0 "SEQEND") ;; Entity type
(cons 8 "0") ;; Layer
)
)
)
;*******************************************************************************
; MAKEHATCH
(defun MakeHatch (lst color)
;; By ElpanovEvgeniy
;; L - list point
;; returne - hatch ename
(entmakex
(apply
'append
(list (list '(0 . "HATCH")
'(100 . "AcDbEntity")
'(100 . "AcDbHatch")
'(10 0.0 0.0 0.0)
'(2 . "SOLID")
(cons 62 color) ; cor
'(91 . 1)
'(92 . 7)
'(72 . 0)
'(73 . 1)
(cons 93 (length lst))
)
(mapcar (function (lambda (p) (cons 10 p))) lst)
(list '(97 . 0))
) ;_ list
) ;_ apply
) ;_ entmakex
) ;_ defun
;*******************************************************************************
; AG:GETPASSO
; solicita o passo da esteira
(defun ag:getPasso (/ tmp passo)
(if (null global:ag_passo) (setq global:ag_passo "90"))
(initget "60 90 120")
(if (setq tmp (getkword (strcat "\Passo [60/90/120] <" global:ag_passo ">: ")))
; if input not is null
(setq global:ag_passo tmp
passo (atoi tmp)
)
; if input is null
(setq passo (atoi global:ag_passo))
)
passo
)
;*******************************************************************************
; AG:GETN
; solicita o n da esteira
(defun ag:getN (/ n)
(if (null global:ag_n) (setq global:ag_n 400))
(setq msg (strcat "\nN <" (itoa global:ag_n) ">: "))
(initget 4)
(if (setq n (getint msg))
(setq global:ag_n n)
(setq n global:ag_n)
)
n
)
;*******************************************************************************
; AG:GETCOMP
; solicita o comprimemto da esteira
(defun ag:getComp (name / var_name comp msg)
(if (null name)
(setq var_name "global:ag_comp")
(setq var_name (strcat "global:ag_" name))
)
;; (eval (read var_name)) read from var
;; (set (read var_name) x) write x on var
(if (null (eval (read var_name))) (set (read var_name) 720))
(setq msg (strcat "\n" name " <" (itoa (eval (read var_name))) ">: "))
(initget 4)
(if (setq comp (getint msg))
(set (read var_name) comp)
(setq comp (eval (read var_name)))
)
comp
)
;*******************************************************************************
; AG:GETINSERTPOINT
; solicita o ponto de insercao da pista
; se nao for informado usa o join_point da ultima pista desenhada
; se nao tem join point fica preso no while ate escolher um ponto
(defun ag:getInsertPoint (/ point msg)
(setq msg (strcat "\nPonto de inserção "
(if (not (null global:ag_join_point))
" <Conectar>:"
":"
)
)
)
; fica preso até entrar com um ponto
(while (null point)
; solicita o ponto
(setq point (getpoint msg))
; se não entrar com o ponto tenta usar o anterio
(if (null point) (setq point global:ag_join_point))
)
point
)
;*******************************************************************************
; AG:GETINSERTANGLE
; solicita o angulo de insercao da esteira
(defun ag:getInsertAngle (point / ang msg)
(if (null global:ag_ang) (setq global:ag_ang 0))
(setq msg (strcat "\nAngulo <" (rtos global:ag_ang) ">: "))
; fica preso até entrar com um ponto
(while (null ang)
(if (setq ang (getangle point msg))
(setq global:ag_ang ang)
(setq ang global:ag_ang)
)
)
ang
)
;*******************************************************************************
; AG:GETVEL
; solicita a velocidade da esteira
(defun ag:getVel ( / vel msg)
(if (null global:ag_vel) (setq global:ag_vel "35"))
(initget "35 45 60 75")
(if (setq vel (getkword (strcat "\nVelocidade [35/45/60/75] <" global:ag_vel ">: ")))
(setq global:ag_vel vel)
(setq vel global:ag_vel)
)
vel
)
;*******************************************************************************
; AG:GETCOR
; solicita a cor da esteira
(defun ag:getCor ( / vel msg)
(if (null global:ag_cor) (setq global:ag_cor "L"))
(initget "L V")
(if (setq cor (getkword (strcat "\nCor [L/V] <" global:ag_cor ">: ")))
(setq global:ag_cor cor)
(setq cor global:ag_cor)
)
(if (eq "L" global:ag_cor) (setq global:ag_cor "V") (setq global:ag_cor "L"))
cor
)
(princ)