forked from hemerfc/ag_autolisp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathag_pdrm.lsp
151 lines (131 loc) · 5.18 KB
/
ag_pdrm.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
;*******************************************************************************
; AG:PDRM
; Cria um bloco para a pista
(defun ag:Pdrm (n passo comp_ant comp_port1 comp_port2 comp_post vel cor point ang / larg rect blockname)
(setq blockname (CreateBlkName
(list "PDRM"
(itoa n)
(itoa passo)
(itoa comp_ant)
(itoa comp_port1)
(itoa comp_port2)
(itoa comp_post)
vel
cor
)
)
)
(if (eq "L" cor) (setq cor 21) (setq cor 101))
(setq larg (+ n 97)) ; largura = n + 60
;; se nao exite um esteira com este nome
;; cria um bloco para ela
(if (null (tblsearch "BLOCK" blockname))
(progn
(entmake (list '(0 . "BLOCK") ; required
'(100 . "AcDbEntity") ; recommended
'(100 . "AcDbBlockBegin") ; recommended
(cons 2 blockname) ; required
'(8 . "0") ; recommended
'(70 . 0) ; required [NOTE 0 if no attributes]
'(280 . 0) ; disable exploding block
'(10 0.0 0.0 0.0) ; required
)
)
;; RECT ANT ************************************************************
(setq rect (list (list 0 0)
(list 0 larg)
(list comp_ant larg)
(list comp_ant 0)
)
)
(MakeHatch rect cor)
(DrawPoly rect 7)
;; RECT PORT1 ************************************************************
(setq rect (list (list comp_ant 0)
(list comp_ant larg)
(list (+ comp_ant comp_port1) larg)
(list (+ comp_ant comp_port1) 0)
)
)
; inverte a cor
(if (eq 101 cor) (setq cor 21) (setq cor 101))
(MakeHatch rect cor)
(DrawPoly rect 7)
;; RECT PORT2 ************************************************************
(setq rect (list (list (+ comp_ant comp_port1) 0)
(list (+ comp_ant comp_port1) larg)
(list (+ comp_ant comp_port1 comp_port2) larg)
(list (+ comp_ant comp_port1 comp_port2) 0)
)
)
; inverte a cor
(if (eq 101 cor) (setq cor 21) (setq cor 101))
(MakeHatch rect cor)
(DrawPoly rect 7)
;; RECT POST ************************************************************
(setq rect (list (list (+ comp_ant comp_port1 comp_port2) 0)
(list (+ comp_ant comp_port1 comp_port2) larg)
(list (+ comp_ant comp_port1 comp_port2 comp_post) larg)
(list (+ comp_ant comp_port1 comp_port2 comp_post) 0)
)
)
; inverte a cor
(if (eq 101 cor) (setq cor 21) (setq cor 101))
(MakeHatch rect cor)
(DrawPoly rect 7)
;; PROTECAO LATERAL ************************************************************
;; cria o retangulo da lateral da esteira
(setq rect (list (list 0 (+ n 30))
(list 0 (+ n 67))
(list (+ comp_ant comp_port1 comp_port2 comp_post) (+ n 67))
(list (+ comp_ant comp_port1 comp_port2 comp_post) (+ n 30))
)
)
(MakeHatch rect 7)
;; TRIANGULO ************************************************************
(setq rect (list (list comp_ant 0)
(list comp_ant larg)
(list (+ comp_ant comp_port1) (/ larg 2))
)
)
(DrawPoly rect 7)
(setq rect (list (list (+ comp_ant comp_port1) (/ larg 2))
(list (+ comp_ant comp_port1 comp_port2) larg)
(list (+ comp_ant comp_port1 comp_port2) 0)
)
)
(DrawPoly rect 7)
(entmake (list '(0 . "ENDBLK") ; required
'(100 . "AcDbBlockEnd") ; recommended
'(8 . "0") ; recommended
)
)
)
)
;; insere o bloco no desenho
(InsertBlk blockname point ang)
;; atualiza o ponto de ligação para a proxima esteira
(setq global:ag_join_point (polar point ang (+ comp_ant comp_port1 comp_port2 comp_post)))
)
;*******************************************************************************
;C:AG_PDRM
; commando para criar pistas psrm
(defun c:ag_pdrm (/ n passo comp_ant comp_port1 comp_port2 comp_post cor vel point point ang)
(terpri)
(print "Entre com os dados para PDRM")
(setq passo (ag:getPasso))
(setq n (ag:getN))
(setq comp_ant (ag:getComp "CompAnt"))
(setq comp_port1 (ag:getComp "CompPort1"))
(setq comp_port2 (ag:getComp "CompPort2"))
(setq comp_post (ag:getComp "CompPost"))
(setq vel (ag:getVel))
(setq cor (ag:getCor))
(setq point (ag:getInsertPoint))
(setq ang (ag:getInsertAngle point))
; cria o bloco
(ag:pdrm n passo comp_ant comp_port1 comp_port2 comp_post vel cor point ang)
(princ)
)
;defun c:ag_psrm
(princ)