I've made an program which makes an "turn back" on two parallel lines.
Is it possible somehow to make the program so like eg.: stretch command works, if the user moves the mouse, realtime shows how the result will looks like.
It would be really good if before clicking for the final position we could see how the result will be.
By the way, why get I after running the program this message?
(defun C:turnback_simple (/ ortho ; save the original value
snapping ; save the original value
r ; radius
a ; first line
b ; second line
pl1 ; first point
pl2 ; second point
ps1 ; firts point
ps2 ; second point
p_inters ; theoretical intersection point of the selected lines
pl1_midle ; point for direction of theoretical middle line
pl2_midle ; point for direction of theoretical middle line
p_end_ARC ; selected point where the ARC should ended
ang1 ; angle
ang2 ; angle
ang_inside ; inside angle between the lines
center ; center point of ARC
object_ARC ; object name of the ARC
en1 ; first entity LINE+point
en2 ; second entity LINE+point
distance_parallel ; distance between the parallel lines
p ; help for exchanging the cordinates
)
(vl-load-com)
(setq ortho (getvar 'orthomode)
snapang (getvar 'snapang)
)
(setq r 3)
(command "fillet" "r" r "")
(setq a (entsel "\n Select the first line"))
(setq b (entsel "\n Select the second line"))
(setq pl1 (vlax-curve-getStartPoint (car a)))
(setq ps1 (vlax-curve-getStartPoint (car b)))
(setq pl2 (vlax-curve-getEndPoint (car a)))
(setq ps2 (vlax-curve-getEndPoint (car b)))
;; ---- check whether there is an intersection - the lines are parallel ???
;; if nil then the LINES are parallel
(setq p_inters (inters pl1 pl2 ps1 ps2 nil))
;; ---- check whether the lines end - start points are on the same end,
;; if not correct it
(if (or (> (distance pl1 ps1) (distance pl1 ps2))
(> (distance pl2 ps2) (distance pl2 ps1))
)
(progn
(setq
p ps2
ps2 ps1
ps1 p
)
) ; progn
) ; if
;; ---- check whether the lines end - start points are close to the selected points,
;; if not correct it
(if (> (distance (cadr a) pl1) (distance (cadr a) pl2))
(progn
(setq
p pl2
pl2 pl1
pl1 p
)
(setq
p ps2
ps2 ps1
ps1 p
)
) ; progn
) ; if
; Create the turn back curve if the lines are parallel
(if (not p_inters)
(progn
(setq ang1 (angle pl1 pl2))
(setq a (list (car a) pl2))
(setq ang2 (angle ps1 ps2))
(setq b (list (car b) ps2))
(setq distance_parallel
(distance
(inters pl1
pl2
ps1
(polar ps1 (+ ang2 (/ pi 2)) 10)
nil
)
ps1
)
)
;; --- calculate the middle points
(setq pl1_midle
(polar ps2 (- ang2 (/ pi 2)) (/ distance_parallel 2))
pl2_midle
(polar ps1 (- ang2 (/ pi 2)) (/ distance_parallel 2))
)
;; --- check whether the pl1_midle is betwwen the lines or is outside
(if (> (distance pl1_midle (inters pl1 pl2 ps2 pl1_midle nil))
distance_parallel
)
(progn
(setq pl1_midle
(polar ps2 (+ ang2 (/ pi 2)) (/ distance_parallel 2))
pl2_midle
(polar ps1 (+ ang2 (/ pi 2)) (/ distance_parallel 2))
)
) ; progn
) ; if
(setvar 'orthomode 1)
(setvar
'snapang
(angle pl1_midle pl2_midle)
)
(setq p_end_ARC
(getpoint pl1_midle "\nSpecify the end of the ARC: ")
)
(setvar 'orthomode ortho)
(setvar 'snapang snapang)
(setq center
(polar
p_end_ARC
(angle pl2_midle pl1_midle)
r
)
)
(entmake (list (cons 0 "Arc")
(cons 10 center)
(cons 40 r)
(cons 51 (- ang2 (/ pi 2)))
(cons 50 (+ ang1 (/ pi 2)))
)
) ;entmake
(setq object_ARC (entlast))
(if (< (distance pl1 (polar center (- ang1 (/ pi 2)) r))
(distance pl1 (polar center (+ ang1 (/ pi 2)) r))
)
(setq
en2 (list
object_ARC
(polar center (- ang1 (/ pi 2)) r)
)
)
(setq
en2 (list
object_ARC
(polar center (+ ang1 (/ pi 2)) r)
)
)
) ; if
(command "fillet" en2 a "")
(if (< (distance ps1 (polar center (+ ang2 (/ pi 2)) r))
(distance ps1 (polar center (- ang2 (/ pi 2)) r))
)
(setq
en2 (list
object_ARC
(polar center (+ ang2 (/ pi 2)) r)
)
)
(setq
en2 (list
object_ARC
(polar center (- ang2 (/ pi 2)) r)
)
)
) ;if
(command "fillet" en2 b "")
);progn
) ;if
(princ)
) ;defun
