Offset Polyline

[bedyr]

Hi

I create a lisp file but I didn't go on for a error. Anybody can help me?

(defun c:pp () 
  (setq p1 (getpoint "get first point : "))
  (setq p1x (car p1))
  (setq p1y (cadr p1))
  (setq count 1)
  (while (< count 100) 
    (setq r (getpoint p1 "reference line"))
    (setq s (getpoint "side"))
    (setq rx (car r))
    (setq ry (cadr r))
    (setq sx (car s))
    (setq sy (cadr s))
    (cond 
      ((and (< ry sy) (= p1x rx) (setq p2 (list p1x (+ ry 5)))))
      ((and (> ry sy) (= p1x rx) (setq p2 (list p1x (- ry 5)))))
      ((and (< rx sx) (= p1y ry) (setq p2 (list (+ rx 5) p1y))))
      ((and (> rx sx) (= p1y ry) (setq p2 (list (- rx 5) p1y))))
      ((and (< rx sx) (< p1x sx) (< p1x rx)) (setq p2 (list (+ rx 5) ry)))
      ((and (> rx sx) (< p1x sx) (< P1x rx)) (setq p2 (list (- rx 5) ry)))
    )
    (command "pline" p1 p2 "")
    (setq p1 p2 )
    (setq count (+ count 1))
  )
)

[Kent1Cooper]

This may not be the only issue, but your (and) functions' parentheses are incorrect:

((and (< ry sy) (= p1x rx)) (setq p2 (list p1x (+ ry 5))))

That one is moved to where it closes the (and) function that is the test condition, and the end of the line has one fewer accordingly.

[bedyr]

The problem is last ry. It must be p2y but I don't know how to write this.

((and (< rx sx) (< p1x sx) (< p1x rx)) (setq p2 (list (+ rx 5) ry)))
((and (> rx sx) (< p1x sx) (< P1x rx)) (setq p2 (list (- rx 5) ry)))

[ВeekeeCZ]

In general, it's not good idea to compare real numbers with no precision defined. Use 

(equal p1x rx 1e-6)

[bedyr]

But it is not my problem. My problem is loop and after get p4 point. 

[Kent1Cooper]

If your p1 gets set to a new starting position with:

  (setq p1 p2)

then don't you also need to give it the updated X and Y coordinates of that new position?  That is, replace that line with:

  (setq p1 p2 p1x (car p1) p1y (cadr p1))

[bedyr]

((and (< ry sy) (= p1x rx) (setq p2 (list p1x (+ ry 5)))))
      ((and (> ry sy) (= p1x rx) (setq p2 (list p1x (- ry 5)))))
      ((and (< rx sx) (= p1y ry) (setq p2 (list (+ rx 5) p1y))))
      ((and (> rx sx) (= p1y ry) (setq p2 (list (- rx 5) p1y))))

after to get p2 point and draw p1 to p2.

((and (< rx sx) (< p1x sx) (< p1x rx)) (setq p3 (list (+ rx 5) ry)))

((and (> rx sx) (< p1x sx) (< P1x rx)) (setq p3 (list (- rx 5) ry)))

I need to draw p2 to p3 . But I don't know how to write p3 point in this loop.

My problem is p3 point.

[Kent1Cooper]

Another little suggestion....

If this:

  (while (< count 100)
is to let you go essentially as long as you want, ending with ESCape and assuming you won't ever reach 100 iterations, there's a simpler  way, and also a better  way.

The simpler  way is:

  (while T

and eliminate the 'count' variable and everything that sets or checks it.  It could also be done with anything that isn't nil, such as:
  (while 1

The better  way is to replace this much:

  (while (< count 100)
    (setq r (getpoint p1 "reference line"))

with this:

  (while (setq r (getpoint p1 "reference line or <exit>"))

Then as long as you pick a point, it will continue, and when you hit Enter to accept that default to exit the command, it will return nil and stop the (while) loop, without the function-cancelled message that you get from hitting ESCape.

Also eliminate the 'count' variable and everything related to it.

[bedyr]

I get a screen record. Because I can't tell my opinion :))

My problem is to get p3 point. I don't have an issue p1 and p2 point. 

((and (< rx sx) (< p1x sx) (< p1x rx)) (setq p2 (list (+ rx 5) ry)))

((and (> rx sx) (< p1x sx) (< P1x rx)) (setq p2 (list (- rx 5) ry)))

p2 must be p3

ry must be p2y

But I don't know how to write this for this lisp.

[hak_vz · Accepted solution]

Try this code:

(defun perperdicular_from_point_to_line (lin1 lin2 p / x1 y1 x2 y2 x3 y3 k m n ret)
;returns point on a line (line1 line2) as a perpendicular projection from point p
	(mapcar 'set '(x1 x2 x3) (mapcar 'car (list lin1 lin2 p)))
	(mapcar 'set '(y1 y2 y3) (mapcar 'cadr (list lin1 lin2 p)))
	(setq 
		m (-(*(- y2 y1) (- x3 x1))(*(- x2 x1) (- y3 y1)))
		n (+(* (- y2 y1)(- y2 y1))(*(- x2 x1)(- x2 x1)))
	)
	(cond 
		((/= n 0.0) 
			(setq 
				k (/ m n)
				ret (list(- x3 (* k(- y2 y1)))(+ y3 (* k(- x2 x1))))
			)
		)
	)
	ret
)
(defun point2d (pt) (list (car pt) (cadr pt)))
(defun c:pp ( / off ss p1 p2 s m enr seg seglist p1 p2 p3 p4 i n int ptlist fst kst i ) 
(setvar old (getvar 'osmode))
(setvar 'osmode 1)
(setq off (getreal "\nEnter offset value >") ptlist nil)
(setq ss (ssadd))
(setq p1 (point2d(getpoint "\nSelect 1. point >")))
(setq p2 (point2d(getpoint "\nSelect 2. point >")))
(setq k p2)
(setvar 'osmode 0)
(setq s (point2d(getpoint "\nPick side> ")))
(setq m (perperdicular_from_point_to_line p1 p2 s))
(command "_.line" p1 p2 "")
(command "_.move" (entlast) "" m (polar m  (angle m s) off))
(setq p1 (mapcar '+ p1 (mapcar '- (polar m  (angle m s) off) m)))
(setq p2 (mapcar '+ p2 (mapcar '- (polar m  (angle m s) off) m)))
(setq seg (mapcar 'point2d (list p1 p2)))
(setq fst (car seg))
(ssadd (entlast) ss)
(setq seglist (cons seg seglist))
(setq p1 k p2 nil)
(setvar 'osmode 1)
(while (and (setq p2 (getpoint "\nSelect 2. point >")))
   (setq p2 (point2d p2) k p2)
    (setvar 'osmode 0)
    (setq s (point2d(getpoint "\nPick side> ")))
    (setq m (perperdicular_from_point_to_line p1 p2 s))
    (command "_.line" p1 p2 "")
    (command "_.move" (entlast) "" m (polar m  (angle m s) off))
    (setq p1 (mapcar '+ p1 (mapcar '- (polar m  (angle m s) off) m)))
    (setq p2 (mapcar '+ p2 (mapcar '- (polar m  (angle m s) off) m)))

    (ssadd (entlast) ss)
    (setq seg (mapcar 'point2d (list p1 p2)))
    (ssadd (entlast) ss)
    (setq seglist (cons seg seglist))
    (setq p1 k p2 nil)
    (setvar 'osmode 1)
)
(setq lst (cadr seg))
(setq seglist (reverse seglist))
(setq i 0 n (- (length seglist) 1))
(while (< i n)
(setq seg1 (nth i seglist) seg2 (nth (+ i 1) seglist))
(setq p1 (car seg1) p2 (cadr seg1) p3 (car seg2) p4 (cadr seg2))
(setq int (inters p1 p2 p3 p4 nil) ptlist (cons int ptlist))
(setq i (+ i 1))
)
(setq ptlist (reverse ptlist))
(command "_.erase" ss "")
(command "_.pline" fst)
(while ptlist (command (car ptlist)) (setq ptlist (cdr ptlist)))
(command lst "")
(setvar 'osmode old)
(princ)
)

 Pick in a sequence points and offset side, finish command with <enter> key.  At the end script erases helper lines and creates offset polyline

[bedyr]

I am getting error when start command.  

[hak_vz]

Sorry. Have to check. It now appears at my site too after a restart.

[hak_vz · Accepted solution]

(defun perperdicular_from_point_to_line (lin1 lin2 p / x1 y1 x2 y2 x3 y3 k m n ret)
;returns point on a line (line1 line2) as a perpendicular projection from point p
	(mapcar 'set '(x1 x2 x3) (mapcar 'car (list lin1 lin2 p)))
	(mapcar 'set '(y1 y2 y3) (mapcar 'cadr (list lin1 lin2 p)))
	(setq 
		m (-(*(- y2 y1) (- x3 x1))(*(- x2 x1) (- y3 y1)))
		n (+(* (- y2 y1)(- y2 y1))(*(- x2 x1)(- x2 x1)))
	)
	(cond 
		((/= n 0.0) 
			(setq 
				k (/ m n)
				ret (list(- x3 (* k(- y2 y1)))(+ y3 (* k(- x2 x1))))
			)
		)
	)
	ret
)

(defun point2d (pt) (list (car pt) (cadr pt)))


(defun c:pp ( / off ss p1 p2 s m enr seg seglist p1 p2 p3 p4 i n int ptlist fst kst i ) 

(setq old (getvar 'osmode))
(setvar 'osmode 1)
(setq off (getreal "\nEnter offset value >") ptlist nil)
(setq ss (ssadd))
(setq p1 (point2d(getpoint "\nSelect 1. point >")))
(setq p2 (point2d(getpoint "\nSelect 2. point >")))
(setq k p2)
(setvar 'osmode 0)
(setq s (point2d(getpoint "\nPick side> ")))
(setq m (perperdicular_from_point_to_line p1 p2 s))
(command "_.line" p1 p2 "")
(command "_.move" (entlast) "" m (polar m  (angle m s) off))
(setq p1 (mapcar '+ p1 (mapcar '- (polar m  (angle m s) off) m)))
(setq p2 (mapcar '+ p2 (mapcar '- (polar m  (angle m s) off) m)))
(setq seg (mapcar 'point2d (list p1 p2)))
(setq fst (car seg))
(ssadd (entlast) ss)
(setq seglist (cons seg seglist))
(setq p1 k p2 nil)
(setvar 'osmode 1)
(while (and (setq p2 (getpoint "\nSelect 2. point >")))
   (setq p2 (point2d p2) k p2)
    (setvar 'osmode 0)
    (setq s (point2d(getpoint "\nPick side> ")))
    (setq m (perperdicular_from_point_to_line p1 p2 s))
    (command "_.line" p1 p2 "")
    (command "_.move" (entlast) "" m (polar m  (angle m s) off))
    (setq p1 (mapcar '+ p1 (mapcar '- (polar m  (angle m s) off) m)))
    (setq p2 (mapcar '+ p2 (mapcar '- (polar m  (angle m s) off) m)))

    (ssadd (entlast) ss)
    (setq seg (mapcar 'point2d (list p1 p2)))
    (ssadd (entlast) ss)
    (setq seglist (cons seg seglist))
    (setq p1 k p2 nil)
    (setvar 'osmode 1)
)
(setq lst (cadr seg))
(setq seglist (reverse seglist))
(setq i 0 n (- (length seglist) 1))
(while (< i n)
(setq seg1 (nth i seglist) seg2 (nth (+ i 1) seglist))
(setq p1 (car seg1) p2 (cadr seg1) p3 (car seg2) p4 (cadr seg2))
(setq int (inters p1 p2 p3 p4 nil) ptlist (cons int ptlist))
(setq i (+ i 1))
)
(setq ptlist (reverse ptlist))
(command "_.erase" ss "")
(command "_.pline" fst)
(while ptlist (command (car ptlist)) (setq ptlist (cdr ptlist)))
(command lst "")
(setvar 'osmode old)
(princ)
)

[bedyr]

thank you so much. This is a great idea. But I want to start and end different point. Can we change start and end point?

[hak_vz]

Probably. Please define how would you like the code to operate, so I can add that to the code. This is just a proof of the concept to see if it really works.

[bedyr]

like that

 

[hak_vz]

Easiest solution is to connect edges separately, but I'll try to figure out how to implement this into a code. It's getting late so I'll finish it tomorrow an polish the code for potential errors. 

[bedyr]

ok. Thank you so much 🙏

[hak_vz]

I'll make so that you first create connection lines, and then create offset. At the end will create a trimming operation to remove unnecessary parts and connect all into a single polyline. That's all for now. Thank you for accepting this as a solution.

[Sea-Haven]

I wrote a water main offset and it allows a pline given left or right offset continuations which I think is what your trying to do. It just did fillet pline with new line. It did a question "swap ?" so would flip the offset left  / right as you went along.