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

0 Members and 3 Guests are viewing this topic.

notredave

  • Newt
  • Posts: 140
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: 7526
Re: 2D Closed polyline match lisp routine
« Reply #1 on: August 09, 2017, 11:53:50 AM »
Can you post a sample drawing?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

notredave

  • Newt
  • Posts: 140
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: 7526
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.         (vlax-invoke
  17.           o
  18.           'scaleentity
  19.           (mapcar '(lambda (x) (/ x (length p))) (apply 'mapcar (cons '+ p)))
  20.           (sqrt (/ a (vlax-curve-getarea o)))
  21.         )
  22.       )
  23.     )
  24.   )
  25.   (princ)
  26. )

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12905
  • 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: 140
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: 7526
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 11 x64 - AutoCAD /C3D 2023

Custom Build PC

notredave

  • Newt
  • Posts: 140
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: 12905
  • 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: 7526
Re: 2D Closed polyline match lisp routine
« Reply #9 on: August 09, 2017, 02:13:50 PM »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC