Uma rotina diferente hoje... ela desenha um par de linhas, mais ou menos no estilo das MLINE, com uma diferença: é possível alterar o ponto base da linha enquanto se desenha uma linha, algo como, começa pelo ponto a esquerda da linha e termina pelo lado direito, melhor vocês rodarem ela pra ver o que acontece... então deixa eu ver!
(defun c:ml2  (/ tmp ip fp lst lp of)
(
tbn:error-init (list (list "cmdecho" 0) t))
(
setq ip "D"
fp "D"
lst nil
lp nil
of 0.15
lay (getvar "clayer"))
(
while (progn (initget (strcat "O D E C U S I" (if (> (length lst) 1) " F" "")) 0)
(
setq str (strcat "\noffset: " (rtos of 2) " Inicio:\"" ip
"\" Fim:\"" fp
"\"\nEntre com um ponto ou [Offset, Direita, Centro, Esquerda, Início"
(if (> (length lst) 1) ", Fechar" "")
", Sair, Undo] <Sair>")
tmp (if lp
(getpoint (trans lp 0 1) str)
(
getpoint str)))
(
if (= tmp "F")
(
progn
(setq fp (caddar lst))
(
ml2_processaponto (dxf 10 (cadar lst)) lay)
(
ml2_chanfra
(caar lst)
(
cadar lst)
(
car (last lst))
(
cadr (last lst)))
(
setq tmp "S")))
(
/= "S" (if tmp tmp "S")))
(
cond ((= "O" tmp)
(
if (setq tmp
(getdist
(strcat "\nEntre com o offset <" (rtos of 2) ">")))
(
setq of tmp)))
((
= "I" tmp)
(
initget "D E C" 0)
(
if (setq tmp
(getkword
(strcat
"\nIniciar com [Direita, Centro, Esquerda] <"
ip
">")))
(
setq ip tmp)))
((
member tmp '("D" "C" "E")) (setq fp tmp))
((
= "U" tmp)
(
setq tmp (last lst)
lst (vl-remove tmp lst))
(
del-ent (car tmp))
(
del-ent (cadr tmp))
(
setq ip (caddr tmp)
fp (cadddr tmp)
lp (nth 4 tmp)))
((
= "F" tmp)
(
setq fecha t))
((
listp tmp) (ml2_processaponto (trans tmp 1 0) lay))))
(
tbn:error-restore))

(
defun ml2_processaponto
(tmp lay / str ang an2 dist p1 p2 p3 p4 e1 e2)
(
if (not lp)
(
setq lp tmp)
(
progn
(setq ang (angle lp tmp)
dist (distance lp tmp))
(
cond ((= ip fp "C") ;ok2
(setq an2 (+ ang (/ pi 2))
p3 (polar lp an2 (/ of 2))
p4 (polar tmp an2 (/ of 2))
p1 (polar lp an2 (/ of -2))
p2 (polar tmp an2 (/ of -2))))
((
= ip fp "E") ;ok2
(setq an2 (+ ang (/ pi 2))
p1 lp
p2 tmp
p3
(polar lp an2 of)
p4 (polar tmp an2 of)))
((
= ip fp "D") ;ok2
(setq an2 (- ang (/ pi 2))
p1 (polar lp an2 of)
p2 (polar tmp an2 of)
p3 lp
p4 tmp
))
((
= ip "D")
(
if (= fp "E")
(
setq an2 (- ang (acos (/ of (distance lp tmp)))) ;ok2
p1 (polar lp an2 of)
p2 tmp
p3 lp
p4
(polar tmp an2 (- of)))
(
setq an2 (- ang (acos (/ of (* 2 (distance lp tmp)))))
;ok2
p3 lp
p4
(polar tmp an2 (/ of -2))
p1 (polar lp an2 of)
p2 (polar tmp an2 (/ of 2)))))
((
= ip "E")
(
if (= fp "D") ;ok2
(setq an2 (+ ang (acos (/ of (distance lp tmp))))
p1 (polar lp an2 of)
p2 tmp
p3 lp
p4
(polar tmp an2 (- of)))
(
setq an2 (+ ang (acos (/ of (* 2 (distance lp tmp)))))
;ok2
p1 (polar lp an2 of)
p2 (polar tmp an2 (/ of 2))
p3 lp
p4
(polar tmp an2 (/ of -2)))))
((
= ip "C")
(
if (= fp "D")
(
setq an2 (+ ang (acos (/ of (* 2 (distance lp tmp)))))
p3 (polar lp an2 (/ of 2))
p4 tmp
p1
(polar lp an2 (/ of -2))
p2 (polar tmp an2 (- of)))
(
setq an2 (+ ang (acos (/ of (* 2 (distance lp tmp)))))
p3 (polar lp an2 (/ of 2))
p4 (polar tmp an2 of)
p1 (polar lp an2 (/ of -2))
p2 tmp))))
(
setq e1 (draw-line (remove-n 2 p1) (remove-n 2 p2) lay)
e2 (draw-line (remove-n 2 p3) (remove-n 2 p4) lay)
ip fp
lst
(append lst (list (list e1 e2 ip fp lp)))
lp tmp)
(
if (> (length lst) 1)
(
progn
(setq tmp (nth (- (length lst) 2) lst))
(
ml2_chanfra e1 e2 (car tmp) (cadr tmp))
)))))

(
defun ml2_chanfra (e1 e2 a1 a2 / p1 p2 tmp a b)
(
setq p1 (inters (dxf 10 a1) (dxf 11 a1) (dxf 10 e1) (dxf 11 e1) nil)
p2 (inters (dxf 10 a2) (dxf 11 a2) (dxf 10 e2) (dxf 11 e2) nil)
a (draw-pline2 (list (dxf 10 a1) p1 (dxf 11 e1)) "0" nil)
b (draw-pline2 (list (dxf 10 a2) p2 (dxf 11 e2)) "0" nil))
(
if (> (length (get-intersectpoints a b)) 0)
(
setq tmp e1
e1 e2
e2 tmp
p1
(inters (dxf 10 a1) (dxf 11 a1) (dxf 10 e1) (dxf 11 e1) nil)
p2 (inters (dxf 10 a2) (dxf 11 a2) (dxf 10 e2) (dxf 11 e2) nil)))
(
del-ent a)
(
del-ent b)
(
remake-ent a1 11 p1)
(
remake-ent a2 11 p2)
(
remake-ent e1 10 p1)
(
remake-ent e2 10 p2))

Nenhum comentário:

Postar um comentário