Centrelines for selected rectangles along major axis without extra offsets

[Anonymous]

Dear Experts,

Need small change in below code, the code shall generate center lines along major axis only, without any extra buffer on both sides.

(defun c:DC (/	 lt  ename   b	 c   sn	 sn1 sn2 p1  p2	 p3  p4	 f
     d	 d1  d2	 d3  a1	 a2  a3	 a4  p5	 p6  p7	 p8  p9	 p10
     sc
    )?
 (command "cm?decho" (getvar "cmdecho"))
 (setq lt "center")
 (if (= (tblsearch "ltype" lt) nil)
   (command "-linetype" "l" lt "acad.lin" "")
 )
 (princ "\n Select rectangles: ")
 (setq	ss  (ssget '((-4 . "<and")
	     (0 . "LWPOLYLINE")
	     (70 . 1)
	     (90 . 4)
	     (-4 . "and>")
	    )
    )
sn  (sslength ss)
sn1 sn
 )
 (repeat sn
   (setq sn2	(1- sn1)
  ename	(ssname ss sn2)
  b	(entget ename)
  b	(member (assoc 10 b) b)
   )
   (while (member (assoc 10 b) b)
     (setq c (append c (list (cdr (assoc 10 b))))
    b (cdr b)
    b (member (assoc 10 b) b)
     )
   )

   (setq f   0.125
  d   0.12
  p1  (nth 0 c)
  p2  (nth 1 c)
  p3  (nth 2 c)
  p4  (nth 3 c)
  c   nil
  d1  (/ (distance p1 p2) 2)
  d2  (/ (distance p2 p3) 2)
  d3  (if (> d1 d2)
	(* d1 0.12)
	(* d2 0.12)
      )
  a1  (angle p1 p2)
  a2  (angle p2 p1)
  a3  (angle p2 p3)
  a4  (angle p3 p2)
  p5  (polar p1 a1 d1)
  p6  (polar p5 a4 d3)
  p7  (polar p6 a3 (+ (* d2 2) (* d3 2)))
  p8  (polar p2 a3 d2)
  p9  (polar p8 a1 d3)
  p10 (polar p9 a2 (+ (* d1 2) (* d3 2)))
  sc  (* (+ d1 d2) f)
  sn1 sn2
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 6 lt)
       (cons 62 3)
       (cons 10 p6)
       (cons 11 p7)
       (cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 6 lt)
       (cons 62 3)
       (cons 10 p9)
       (cons 11 p10)
       (cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
 )
 (princ)
)??

[ВeekeeCZ · Accepted solution]

You should be able to do this on your own, really.

(defun c:DCentrer (/	 lt  ename   b	 c   sn	 sn1 sn2 p1  p2	 p3  p4	 f
     d	 d1  d2	 d3  a1	 a2  a3	 a4  p5	 p6  p7	 p8  p9	 p10
     sc
    );?
 ;(command "cm?decho" (getvar "cmdecho"))
 (setq lt "center")
 (if (= (tblsearch "ltype" lt) nil)
   (command "-linetype" "l" lt "acad.lin" "")
 )
 (princ "\n Select rectangles: ")
 (setq	ss  (ssget '((-4 . "<and")
	     (0 . "LWPOLYLINE")
	     (70 . 1)
	     (90 . 4)
	     (-4 . "and>")
	    )
    )
sn  (sslength ss)
sn1 sn
 )
 (repeat sn
   (setq sn2	(1- sn1)
  ename	(ssname ss sn2)
  b	(entget ename)
  b	(member (assoc 10 b) b)
   )
   (while (member (assoc 10 b) b)
     (setq c (append c (list (cdr (assoc 10 b))))
    b (cdr b)
    b (member (assoc 10 b) b)
     )
   )

   (setq f   0.125
  d   0.12
  p1  (nth 0 c)
  p2  (nth 1 c)
  p3  (nth 2 c)
  p4  (nth 3 c)
  c   nil
  d1  (/ (distance p1 p2) 2)
  d2  (/ (distance p2 p3) 2)
  d3  (if (> d1 d2)
	(* d1 0.)
	(* d2 0.)
      )
  a1  (angle p1 p2)
  a2  (angle p2 p1)
  a3  (angle p2 p3)
  a4  (angle p3 p2)
  p5  (polar p1 a1 d1)
  p6  (polar p5 a4 d3)
  p7  (polar p6 a3 (+ (* d2 2) (* d3 2)))
  p8  (polar p2 a3 d2)
  p9  (polar p8 a1 d3)
  p10 (polar p9 a2 (+ (* d1 2) (* d3 2)))
  sc  (* (+ d1 d2) f)
  sn1 sn2
   )
   (if (> (distance p6 p7)
          (distance p9 p10))
     (entmake (list
       (cons 0 "LINE")
       (cons 6 lt)
       (cons 62 3)
       (cons 10 p6)
       (cons 11 p7)
       (cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   )
   (entmake (list
       (cons 0 "LINE")
       (cons 6 lt)
       (cons 62 3)
       (cons 10 p9)
       (cons 11 p10)
       (cons 48 sc)
       (cons 210 (list 0.0 0.0 1.0))
     )
   ))
 )
 (princ)
);??

btw there are quite a few question marks in the code which probably should not be there.