Rectangle, square center line cross lisp?

[mdbdesign]

As per title: anybody got lisp that will draw center line cross for any rectangle or square?

Thank you.

[David Bethel]

What is the rectangle made from? SOLID TRACE LINEs POLYLINE LWPOLYLINE 3DFACE MESH INSERT Picked Points?

 

-David

[mdbdesign]

Most often it is polyline, let say - always polyline (Command: _rectang)

[ketxu]

You maybe start at :

(defun c:test(/ eLine ll ur pl pr pt pb ex)
(defun eLine(p1 p2)(entmakex (list (cons 0 "LINE")(cons 62 3)(cons 10 p1)(cons 11 p2)(cons 6 "CENTER")))) 
;be sure CENTER linetype is loaded, if not, clear [b](cons 6 "CENTER")[/b]
(while    (setq e (car(nentsel "Select Object :")))
   (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
   (setq ll (vlax-safearray->list ll)
       ur (vlax-safearray->list ur)
       ex (/ (abs (-(car ll)(car ur))) 6) ;Extend outside Rectangle
       pl (list (- (car ll) ex) (/ (+ (cadr ll)(cadr ur)) 2))
       pr (list (+ (car ur) ex) (cadr pl))
       pt (list (/ (+ (car ll)(car ur)) 2) (+ (cadr ur) ex))
       pb (list (car pt) (- (cadr ll) ex))
   )
   (eLine pl pr)
   (eLine pt pb)
)
)

[paulmcz]

I have one

 

(defun c:cr (/	 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 "cmdecho" (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)
)

[Tharwat]

A little bit late , but better than nothing ....

 

(defun c:TesT (/ ss e lst Vlen Hlen c p1 p2 p3 p4)
;;; Tharwat 27. Sep. 2011 ;;;
 (if (and
       (setq ss (ssget "_+.:S:L" '((0 . "LWPOLYLINE"))))
       (member (cdr (assoc 0 (setq e (entget (ssname ss 0)))))
               '("LWPOLYLINE" "POLYLINE")
       )
       (eq (vlax-curve-getendparam (ssname ss 0)) 4.0)
     )
   (progn
     (setq lst
            (vl-remove-if-not (function (lambda (x) (eq (car x) 10))) e)
     )
     (setq Vlen (distance (nth 0 lst) (nth 1 lst)))
     (setq Hlen (distance (nth 1 lst) (nth 2 lst)))
     (setq c (inters (nth 0 lst) (nth 2 lst) (nth 1 lst) (nth 3 lst)))
     (setq p1 (polar (setq c (list (cadr c) (caddr c) 0.0))
                     pi
                     (+ (/ Vlen 2.) (/ Vlen 10.))
              )
     )
     (setq p2 (polar p1 0. (+ Vlen (/ Vlen 5.))))
     (setq p3 (polar c (/ pi 2.) (+ (/ Hlen 2.) (/ Hlen 10.))))
     (setq p4 (polar p3 (+ (/ pi 2.) pi) (+ Hlen (/ Hlen 5.))))
     (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
     (entmakex (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
   )
   (princ)
 )
 (princ)
)

 

Tharwat

[mdbdesign]

Perfect, you both winners.

Thank you.

Paul, what is YUL stand for?

 

PS. Sorry Tharwat, my respond take too long and I miss your post, will test it.

Thank you guys again.

[mdbdesign]

Next winner!

Thank you.

[ketxu]

@mdbdesign : with vla-getboundingbox , you can apply routine with more types of object, Pline, Circle,Hatch....etc

[Tharwat]

Next winner!

Thank you.

 

 

You're welcome .

 

You're also a winner buddy .

 

Thanks .

[Lee Mac]

Another Vanilla LISP version for LightWeight Polylines:

 

 

(defun c:polycen ( / a b c e l x )
   
   ;; Example by Lee Mac 2011  -  www.lee-mac.com

   (setq x 0.1) ;; Line Extension
   
   (while
       (progn (setvar 'ERRNO 0) (setq e (car (entsel "\nSelect LWPolyline: ")))
           (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, Try again.")
               )
               (   (eq 'ENAME (type e))
                   (if (not (eq "LWPOLYLINE" (cdr (assoc 0 (entget e)))))
                       (princ "\nInvalid Object.")
                   )
               )
           )
       )
   )
   (if e
       (progn
           (setq l
               (apply 'append
                   (mapcar
                       (function
                           (lambda ( x )
                               (if (= 10 (car x)) (list (trans (cdr x) e 1)))
                           )
                       )
                       (entget e)
                   )
               )
           )
           (setq l
               (mapcar
                   (function
                       (lambda ( x )
                           (apply 'mapcar (cons x l))
                       )
                   )
                  '(min max)
               )
           )
           (setq c
               (apply 'mapcar
                   (cons
                       (function
                           (lambda ( a b ) (/ (+ a b) 2.0))
                       )
                       l
                   )
               )
           )
           (setq a (* x (- (caadr  l) (caar  l)))
                 b (* x (- (cadadr l) (cadar l)))
           )
           (entmakex
               (list
                   (cons 0 "LINE")
                   (cons 10 (trans (list (- (caar  l) a) (cadr c)) 1 0))
                   (cons 11 (trans (list (+ (caadr l) a) (cadr c)) 1 0))
               )
           )
           (entmakex
               (list
                   (cons 0 "LINE")
                   (cons 10 (trans (list (car c) (- (cadar  l) b)) 1 0))
                   (cons 11 (trans (list (car c) (+ (cadadr l) b)) 1 0))
               )
           )
       )
   )
   (princ)
)

 

Should work in all UCS/Views and all shapes of Polyline.

Edited October 4, 2019 by Lee Mac

[paulmcz]

what is YUL stand for?

 

Google it. 480km NE from your place.

[mdbdesign]

Sorry, just try to break the codes, but it actually is a code of airport.

Got same thing on my watch describing time zone - just curiosity.

Thank you Lee for codes. Will try it at home. Home time.

[Lee Mac]

Thank you Lee for codes. Will try it at home. Home time.

 

You're welcome Marek, have a good journey mate.

[mdbdesign]

Lee, you are next winner Congratulation you win:fishing:.

Beer for everybody, Paul you coming, you are the closest...

[paulmcz]

Salmon run? Sure I am coming. Do you smoke them?

[mdbdesign]

First, Lee got to catch some...salmon

Edited September 28, 2011 by mdbdesign
What Lee got to catch.

[Lee Mac]

Not sure where this conversation is going.... but glad you like the code

[mdbdesign]

Lee, above post edited. Sorry we get

Thank you again.

[git_thailand]

lee , please code for select multi rectangle and delete them.