LISP - draw center line of a rectangle

[cool.stuff]

Hi!!

Is is possible to draw the center line of a rectangle polyline along its bigger side?

For instance, when the rectangle has 4 of length and 1 of width, a center line of 4 is drawn.

If it is a square, it is indifferent which side is drawn.

Any help would be deeply appreciated.

Many many thanks in advance

[komondormrex · Accepted solution]

yet another lengthy) one

(defun c:rect_center_mark (/ ename_index ignore_empty_sset ename_sset object center_point skip_ename x_length y_length angle_x angle_y ucs_angle_correction active_layer_locked is_center_line)
	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(defun half (argument) (* 0.5 argument))
	(setvar 'cmdecho 0)
	(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))) "CENTER2")))
		(command "._-linetype" "_l" "CENTER2" "acadiso.lin" "")
	)
	(setvar 'cmdecho 1)
	(if (and
			(equal (car (getvar 'ucsydir)) (cos (+ (* 0.5 pi) (angle '(0 0) (getvar 'ucsxdir)))) 1e-3)			
			(equal (cadr (getvar 'ucsydir)) (sin (+ (* 0.5 pi) (angle '(0 0) (getvar 'ucsxdir)))) 1e-3)       	
		)
			(setq ucs_angle_correction 1)
			(setq ucs_angle_correction -1)
	)
	(if (minusp (vlax-get (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object))) 'lock))
			(setq active_layer_locked t)
			(setq active_layer_locked nil)
	)
	(if (null active_layer_locked)
		(repeat (sslength (setq ename_index -1
					ignore_empty_sset (while (null (setq ename_sset (vl-catch-all-apply 'ssget (list (list '(0 . "lwpolyline") '(-4 . "&=") '(70 . 1) '(90 . 4)))))))
					ename_sset (cond
							((vl-catch-all-error-p ename_sset) (princ "\nCommand cancelled") (ssadd))
							(t ename_sset)
						   )
				  )
			)
				(setq object (vlax-ename->vla-object (ssname ename_sset (setq ename_index (1+ ename_index)))) skip_ename nil)
				(cond
					(
						(and
							 (zerop (apply '+ (mapcar 'abs (mapcar 'cdr (vl-remove-if-not '(lambda (group) (= 42 (car group))) (entget (ssname ename_sset ename_index)))))))
							 (equal (distance (vlax-curve-getpointatparam object 0) (vlax-curve-getpointatparam object 2))
								 	  (distance (vlax-curve-getpointatparam object 1) (vlax-curve-getpointatparam object 3))
									  1e-8
							 )
							 (equal (angle (vlax-curve-getpointatparam object 0) (vlax-curve-getpointatparam object 1))
								       (angle (vlax-curve-getpointatparam object 3) (vlax-curve-getpointatparam object 2))
								       1e-8
							 )
							 (equal (angle (vlax-curve-getpointatparam object 1) (vlax-curve-getpointatparam object 2))
								       (angle (vlax-curve-getpointatparam object 0) (vlax-curve-getpointatparam object 3))
								       1e-8
							 )
						)
							(setq center_point (mapcar 'half (mapcar '+ (vlax-curve-getpointatparam object 0) (vlax-curve-getpointatparam object 2)))
							      angle_x (* ucs_angle_correction (angle (vlax-curve-getpointatparam object 1) (vlax-curve-getpointatparam object 2)))
							      angle_y (* ucs_angle_correction (angle (vlax-curve-getpointatparam object 0) (vlax-curve-getpointatparam object 1)))
							      x_length (half (distance (vlax-curve-getpointatparam object 1) (vlax-curve-getpointatparam object 2)))
							      y_length (half (distance (vlax-curve-getpointatparam object 0) (vlax-curve-getpointatparam object 1)))
							)
					 		(if (<= 2.35 (apply '/ (vl-sort (list x_length y_length) '>))) (setq is_center_line t) (setq is_center_line nil))
							(if (< x_length y_length) (setq x_length y_length angle_x angle_y))
					)
						(
							t
								(setq skip_ename t)
						)
				)
				(if (null skip_ename)
					(progn
					  	(if is_center_line
							(vla-put-linetype
							  	(setq center_mark (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
											       (vlax-3d-point (polar center_point (* ucs_angle_correction angle_x) x_length))
											       (vlax-3d-point (polar center_point (* ucs_angle_correction (+ pi angle_x)) x_length))
										  )
							        )
							  	"CENTER2"
							)
						  	(setq center_mark (vla-addpoint (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
										        (vlax-3d-point center_point)
									  )
						        )
					  	)
					  	(vla-put-layer center_mark (vla-get-layer object))
				  	)
				)
		)
		(princ "\nActive layer locked. Command cancelled.")
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)