lisp with polyline

[manasi4532]

I'm looking for a Lisp routine that can take a selected polyline, extrude it vertically by a specified height, and create a new closed polyline.  I have attached an example here as well. Thank you very much. 

[komondormrex]

check the following

(defun c:minus_offset_dist (/ source_data mid_edge_param mid_edge_point edge_start_point edge_end_point angle_)
  	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(setq source_data (entsel "\nPick target edge of source pline: ")
		mid_edge_param (+ 0.5 (fix (vlax-curve-getparamatpoint (car source_data) (vlax-curve-getclosestpointto (car source_data) (cadr source_data)))))
		mid_edge_point (vlax-curve-getpointatparam (car source_data) mid_edge_param)
		edge_start_point (vlax-curve-getpointatparam (car source_data) (1+ (fix mid_edge_param)))
		edge_end_point (vlax-curve-getpointatparam (car source_data) (fix mid_edge_param))
		angle_ (cond
			 ((equal (cadr edge_start_point) (cadr edge_end_point)) (* pi 0.5))  
			 ((minusp (setq angle_ (atan (apply '/ (mapcar '+ '(0 0) (mapcar '- edge_end_point edge_start_point)))))) (- angle_))
			 (t (- pi angle_))
			)
	        dist 15
	)
	(vla-move (setq pline_copy (vla-copy (vlax-ename->vla-object (car source_data))))
		  (vlax-3d-point mid_edge_point)
		  (vlax-3d-point (polar mid_edge_point angle_ dist))
	)
  	(command "_bpoly" (polar mid_edge_point angle_ (* 0.5 dist)) "")
  	(entdel (car source_data))
  	(vla-erase pline_copy)
  	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  	(princ)
)

[manasi4532]

Thank you so much for help 😍

[manasi4532]

I have a problem. At first it said error lisp error: malformed list on input.  I edited the code. But some parts came out with abnormal shapes. Some parts are usable.  How do I fix it?

(defun c:minus_offset_dist (/ source_data mid_edge_param mid_edge_point edge_start_point edge_end_point angle_ dist pline_copy)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))

(setq source_data (entsel "\nPick target edge of source pline: "))


(setq mid_edge_param (+ 0.5 (fix (vlax-curve-getparamatpoint (car source_data)
(vlax-curve-getclosestpointto (car source_data) (cadr source_data))))))

(setq mid_edge_point (vlax-curve-getpointatparam (car source_data) mid_edge_param)
edge_start_point (vlax-curve-getpointatparam (car source_data) (1+ (fix mid_edge_param)))
edge_end_point (vlax-curve-getpointatparam (car source_data) (fix mid_edge_param)))

(setq angle_ (cond
((equal (cadr edge_start_point) (cadr edge_end_point)) (* pi 0.5))
((minusp (setq angle_ (atan (apply '/ (mapcar '+ '(0 0) (mapcar '- edge_end_point edge_start_point)))))) (- angle_))
(t (- pi angle_))
))

(setq dist 15)

(setq pline_copy (vla-copy (vlax-ename->vla-object (car source_data))))
(vla-move pline_copy (vlax-3d-point mid_edge_point) (vlax-3d-point (polar mid_edge_point angle_ dist)))

(command "_bpoly" (polar mid_edge_point angle_ (* 0.5 dist)) "")

(entdel (car source_data))
(vla-erase pline_copy)

(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

(princ)
)

[komondormrex]

the code primarily will work on the shapes that are tapering to the top. otherwise it will give unpredictable results. but i will see later on what could be done to make it work regardless on that very condition.

[manasi4532]

I truly appreciate your help.