Author Topic: 2D Closed polyline match lisp routine  (Read 351 times)

0 Members and 1 Guest are viewing this topic.

notredave

  • Newt
  • Posts: 45
2D Closed polyline match lisp routine
« on: August 09, 2017, 11:13:53 am »
Good morning all,

After Google searching with no luck, does anyone know or have a lisp routine willing to share with me that will match a rectangular polyline (2d)? I have hundreds of boxes (rectangular 2d polyline) that the drawing borders has changed scales. That leaves me having to scale down hundreds of rectangular boxes. I would also love it, if it would keep current orientation. I have combination of horizontal and vertical boxes. If anyone has seen such a lisp routine, PLEASE let me know. I would greatly appreciate it.

Thank you and good day,
David

ronjonp

  • Needs a day job
  • Posts: 6278
Re: 2D Closed polyline match lisp routine
« Reply #1 on: August 09, 2017, 11:53:50 am »
Can you post a sample drawing?

Windows 10 x64 - AutoCAD /C3D 2018

Custom Build PC

notredave

  • Newt
  • Posts: 45
Re: 2D Closed polyline match lisp routine
« Reply #2 on: August 09, 2017, 12:18:46 pm »
I sure can, see attached....

ronjonp

  • Needs a day job
  • Posts: 6278
Re: 2D Closed polyline match lisp routine
« Reply #3 on: August 09, 2017, 12:32:58 pm »
Give this a try:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:s2a (/ _boundingbox a e p s)
  2.  (defun _boundingbox (o / ll ur)
  3.    (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'll 'ur))))
  4.     (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
  5. )
  6.      (list ll ur)
  7.    )
  8.  )
  9.  (if (and (setq e (car (entsel "\nPick polyline to match: ")))
  10.   (= (type (setq a (vl-catch-all-apply 'vlax-curve-getarea (list e)))) 'real)
  11.   (not (= 0.0 a))
  12.   (setq s (ssget ":L" '((0 . "*polyline"))))
  13.      )
  14.    (foreach o (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
  15.      (if (setq p (_boundingbox o))
  16.  o
  17.  'scaleentity
  18.  (mapcar '(lambda (x) (/ x (length p))) (apply 'mapcar (cons '+ p)))
  19.  (sqrt (/ a (vlax-curve-getarea o)))
  20. )
  21.      )
  22.    )
  23.  )
  24.  (princ)
  25. )

Windows 10 x64 - AutoCAD /C3D 2018

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 11733
  • AutoCAD 2015 Windows 7 London, England
Re: 2D Closed polyline match lisp routine
« Reply #4 on: August 09, 2017, 12:40:45 pm »
Here's a start - this will maintain the proportions of each rectangle:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:matchrec ( / ent idx lng lst sel src )
  2.    (if
  3.        (and
  4.            (setq src (selectif "\nSelect source rectangle: " 'rectangle-p))
  5.            (setq sel (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1) (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>"))))
  6.        )
  7.        (progn
  8.            (setq lst (lwvertices (entget src))
  9.                  lng (apply 'max (mapcar 'distance lst (cdr lst)))
  10.            )
  11.            (repeat (setq idx (sslength sel))
  12.                (setq idx (1- idx)
  13.                      ent (ssname sel idx)
  14.                      lst (lwvertices (entget ent))
  15.                )
  16.                (vla-scaleentity
  17.                    (vlax-ename->vla-object ent)
  18.                    (vlax-3D-point (trans (mapcar '/ (apply 'mapcar (cons '+ lst)) '(4.0 4.0)) ent 0))
  19.                    (/ lng (apply 'max (mapcar 'distance lst (cdr lst))))
  20.                )
  21.            )
  22.        )
  23.    )
  24.    (princ)
  25. )
  26. (defun selectif ( msg prd / ent )
  27.    (while
  28.        (not
  29.            (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
  30.                (cond
  31.                    (   (= 7 (getvar 'errno))
  32.                        (prompt "\nMissed, try again.")
  33.                    )
  34.                    (   (null ent))
  35.                    (   (apply prd (list ent)))
  36.                    (   (prompt "\nInvalid object selected."))
  37.                )
  38.            )
  39.        )
  40.    )
  41.    ent
  42. )    
  43. (defun rectangle-p ( ent / p1 p2 p3 p4 )
  44.    (and (setq enx (entget ent))
  45.         (= "LWPOLYLINE" (cdr (assoc 0 enx)))
  46.         (= 4 (cdr (assoc 90 enx)))
  47.         (= 1 (logand 1 (cdr (assoc 70 enx))))
  48.         (nobulge-p enx)
  49.         (mapcar 'set '(p1 p2 p3 p4) (lwvertices enx))
  50.         (equal (distance p1 p2) (distance p3 p4) 1e-8)
  51.         (equal (distance p2 p3) (distance p1 p4) 1e-8)
  52.         (equal (distance p1 p3) (distance p2 p4) 1e-8)
  53.    )
  54. )
  55. (defun nobulge-p ( enx / bul )
  56.    (or (not (setq bul (assoc 42 enx)))
  57.        (and (equal 0.0 (cdr bul) 1e-8)
  58.             (nobulge-p (cdr (member bul enx)))
  59.        )
  60.    )
  61. )
  62. (defun lwvertices ( enx / vtx )
  63.    (if (setq vtx (assoc 10 enx))
  64.        (cons (cdr vtx) (lwvertices (cdr (member vtx enx))))
  65.    )
  66. )

notredave

  • Newt
  • Posts: 45
Re: 2D Closed polyline match lisp routine
« Reply #5 on: August 09, 2017, 12:56:41 pm »
WOW!!!

Ronjonp and Lee Mac, I want to thank you both so much for these lisp routines! They both work awesome!
I don't but wish I understood the language you both speak, LOL.
I'm being sincere when I say "Thank you so much!"
You have made my day. Hoping you two gents have a wonderful day!

Thanks again,
David

ronjonp

  • Needs a day job
  • Posts: 6278
Re: 2D Closed polyline match lisp routine
« Reply #6 on: August 09, 2017, 01:01:18 pm »
Glad to help out :) ... after looking at your test drawing, have you thought about creating an mleader style that uses your block? IMO that would tidy up the drawing quite a bit.

Windows 10 x64 - AutoCAD /C3D 2018

Custom Build PC

notredave

  • Newt
  • Posts: 45
Re: 2D Closed polyline match lisp routine
« Reply #7 on: August 09, 2017, 01:15:08 pm »
Ronjonp,
No, I have not thought about that. But, I just tried it. Thank you for your suggestion!

Lee Mac

  • Seagull
  • Posts: 11733
  • AutoCAD 2015 Windows 7 London, England
Re: 2D Closed polyline match lisp routine
« Reply #8 on: August 09, 2017, 01:55:37 pm »
You're most welcome David, thank you for your gratitude.

Nice variation Ron  :-)

ronjonp

  • Needs a day job
  • Posts: 6278
Re: 2D Closed polyline match lisp routine
« Reply #9 on: August 09, 2017, 02:13:50 pm »

Windows 10 x64 - AutoCAD /C3D 2018

Custom Build PC