Jump to content

Rectangle, square center line cross lisp?

mdbdesign

By mdbdesign
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mdbdesign Experienced

mdbdesign

Posted
  • Author
Posted

HI JACK

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

I think you need to start new thread, unless Lee will do it, but it got nothing to do with centerline in rectangle...

  • Replies 33
  • Created
  • Last Reply

Top Posters In This Topic

  • mdbdesign

    9

  • Lee Mac

    7

  • martinle

    4

  • paulmcz

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

git_thailand
git_thailand

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

Posted Images

  • 1 month later...
martinle Community Regular

martinle

Posted
Posted

Hello Master Lee Mac!

 

This is a great Lisp.

Is it possible to convert this Lisp Sun at each vertex of a selected polyline (rectangles only) a xline runs vertically or horizontally. It would be great if it would work in all ucs.

 

Thank you very much.

 

love

 

Martin

 

Another Vanilla LISP version for LightWeight Polylines:

 

[ATTACH]30239[/ATTACH]

 

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

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

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

antistar Enthusiast

antistar

Posted
Posted
Another Vanilla LISP version for LightWeight Polylines:

 

[ATTACH]30239[/ATTACH]

 

([color=BLUE]defun[/color] c:polycen ( [color=BLUE]/[/color] a b c e l x )

[color=GREEN];; Example by Lee Mac 2011 - www.lee-mac.com[/color]

([color=BLUE]setq[/color] x 0.1) [color=GREEN];; Line Extension[/color]

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

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

 

Hi Lee,

Great work is very helpful to me.

However, the routine selects only LWPOLYLINES, how to change to also work with POLYLINES?

 

Thanks in advance.

Lee Mac Grand Master

Lee Mac

Posted
Posted
Is it possible to convert this Lisp Sun at each vertex of a selected polyline (rectangles only) a xline runs vertically or horizontally. It would be great if it would work in all ucs.

 

Martin, could you provide a simple diagram of what you are looking to achieve?

 

Hi Lee,

Great work is very helpful to me.

However, the routine selects only LWPOLYLINES, how to change to also work with POLYLINES?

 

This is not a simple modification to the code, but could be done - I'll see if I have time.

antistar Enthusiast

antistar

Posted
Posted
Martin, could you provide a simple diagram of what you are looking to achieve?

 

 

 

This is not a simple modification to the code, but could be done - I'll see if I have time.

 

Thanks Lee, for your attention.

martinle Community Regular

martinle

Posted
Posted

xline.png

 

Hello Master Lee!

 

Excuse me if I am only now reportable.

I've attached a picture so they understand what I mean.

 

Best regards Martin

 

 

 

 

 

 

 

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)
martinle said:
Excuse me if I am only now reportable.

I've attached a picture so they understand what I mean.

 

Best regards Martin

 

This was really fun to write :playing:

(defun c:pxl ( / e )

   (defun _lwvertices ( e / p )
       (if (setq p (assoc 10 e))
           (cons (cdr p) (_lwvertices (cdr (member p e))))
       )
   )

   (defun _polyvertices ( e )
       (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
           (cons (cdr (assoc 10 (entget e))) (_polyvertices (entnext e)))
       )
   )

   (defun _vertices ( e )
       (if (eq "POLYLINE" (cdr (assoc 0 (entget e))))
           (_polyvertices (entnext e))
           (_lwvertices (entget e))
       )
   )

   (defun _selectif ( m f / e ) (setq f (eval f))
       (while
           (progn (setvar 'ERRNO 0) (setq e (car (entsel m)))
               (cond
                   (   (= 7 (getvar 'ERRNO))
                       (princ "\nMissed, try again.")
                   )
                   (   (eq 'ENAME (type e))
                       (if (not (f e)) (princ "\nInvalid Object."))
                   )
               )
           )
       )
       e
   )

   (if
       (setq e
           (_selectif "\nSelect Polyline: "
              '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "*POLYLINE"))
           )
       )
       (
           (lambda ( l )
               (mapcar
                   (function
                       (lambda ( a b )
                           (entmakex
                               (list
                                  '(0 . "XLINE")
                                  '(100 . "AcDbEntity")
                                  '(100 . "AcDbXline")
                                   (cons 10 (trans a e 0))
                                   (cons 11 (trans (mapcar '- b a) e 0))
                               )
                           )
                       )
                   )
                   l (cons (last l) l)
               )
           )
           (_vertices e)
       )
   )
   (princ)
)

Will work for any shape of LWPolylines / Polylines, in all UCS.

Edited by Lee Mac
martinle Community Regular

martinle

Posted
Posted

Hello Mr. Lee!

 

Great!

 

Would it be possible selection only horizontally or only vertically xlines?

 

Best regards Martin

Lee Mac Grand Master

Lee Mac

Posted
Posted

Martin,

 

This is all the voluntary time I am willing to commit to this program; if you require further modification you can contact me directly, either using the PM system, or through my website.

 

Lee

martinle Community Regular

martinle

Posted
Posted

Hello Mr. Lee!

 

You are the master! Without a doubt, and I admire their efforts here in the forum!

 

Thank you very much!

 

Best regards Martin

  • 7 years later...
Lippens Infra Apprentice

Lippens Infra

Posted
Posted

Hi, 

 

I'm new to the LISP department of autocad/bricscad.

 

I was in need of this function as well. 

The only one i could get to work on my bricscad is this one.

now i have the issue that i have rotated rectangles. 

 

Can i add some line(s) to get my center lines rotated along with the rectangles?

 

thanks y'all.

On 9/27/2011 at 6:49 PM, Tharwat said:

  


(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

 

Tharwat Grand Master

Tharwat

Posted
Posted
7 hours ago, Lippens Infra said:

Can i add some line(s) to get my center lines rotated along with the rectangles?

Hi,

Yes its possible so try the following and let me know.

 

NOTE: You can change the gap value 5.0 in the routine which represents the extended offset distance from the two sides of the selected rectangle and what's more importantly is that you can now select as many as you would like of rectangles with one shot. :)  

(defun c:Test (/ gap int sel ent vr1 vr2 vr3 vr4 ctr)
  ;;	Tharwat 04.10.2019	;;
  (and (setq gap 5.0
             int -1
             sel (ssget '((0 . "LWPOLYLINE") (90 . 4)))
       )
       (while (setq int (1+ int)
                    ent (ssname sel int)
              )
         (mapcar 'set
                 '(vr1 vr2 vr3 vr4)
                 (mapcar 'cdr
                         (vl-remove-if-not
                           '(lambda (x) (eq (car x) 10))
                           (entget ent)
                         )
                 )
         )
         (setq ctr (inters vr1 vr3 vr2 vr4))
         (mapcar '(lambda (x / j k d a o)
                    (mapcar 'set '(j k) x)
                    (setq d (/ (distance j k) 2.0)
                          a (angle j k)
                          o (+ d gap)
                    )
                    (entmake (list '(0 . "LINE")
                                   (cons 10 (polar ctr a o))
                                   (cons 11 (polar ctr (+ a pi) o))
                             )
                    )
                  )
                 (list (list vr1 vr2) (list vr2 vr3))
         )
       )
  )
  (princ)
) (vl-load-com)

 

Lee Mac Grand Master

Lee Mac

Posted
Posted

I have updated my earlier posts to remove the BBCode formatting tags.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...