Topic: Reactor that responds to overlength of a vertex of a polyline

[martinle]

Hello gods of the Lispuniverse,
I always forget that my rectangles can't be longer than 2780 mm.
The objects are not always created with the Rectangle command. I also use lisp which draws a double line and after that
is converted into a rectangle.
The result is always a polyline with 4 sides.
Now I would have thought that I could use a support so that I no longer draw objects where a leg length
is longer than 2780 mm long. However, if I draw an object that is longer than 2780 mm, a warning message should appear on the screen
which I then appear with o.k. must confirm. However, the object should remain as drawn.
Would something like this be possible in a reactor?
I ask the kind gods to help me!
Thanks!

[Crank]

I think this is very hard to do in code. More practical would be to use a parametric block,

[BIGAL]

Google Lee-mac i remember he had something about setting maximum length in a program.

If your using  a lisp why not have a check built in ? Can redefine the "Rectang" command so runs your lisp instead.

[Grrr1337]

Hi, martinle
Here is my take on this:

Code - Auto/Visual Lisp: [Select]

1. ; Alert when a rectangle is drawn over the specified overall-limited length
2. ; Author: Grrr / Grrr1337
3. ; https://www.theswamp.org/index.php?topic=58227.0
4.  
5. ; ----------------------
6. ; ---- Main section ----
7.  
8. (defun C:StartReactor nil (_ExIncludeRtr t) (princ) )
9. (defun C:StopReactor nil (_ExIncludeRtr nil) (princ) )
10.  
11.  
12. (defun _ExIncludeRtr ( b / rtrName limitLength d )
13.   (setq rtrName "RectangleLimitLength")
14.   (setq limitLength 2780)
15.   (foreach rtr (cdar (vlr-reactors :vlr-DocManager-Reactor)) (if (and (listp (setq d (vlr-data rtr))) (= rtrName (car d))) (vlr-remove rtr)) )
16.   (initget (+ 0 2 4))
17.   (if (and b (setq limitLength (cond ((getint (strcat "\nInput desired rectangle `limitLength` <" (itoa limitLength) ">: "))) (limitLength))))
18.     (progn
19.       (vlr-DocManager-Reactor (list rtrName limitLength) '((:VLR-documentLockModeChanged . test:CB)))
20.       (alert (strcat "`Rectangle Limit Length` Reactor is active\nLimit is: " (itoa limitLength) " units."))
21.     )
22.   )
23. ); defun
24.  
25.  
26. ; ---------------------------
27. ; ---- Callbacks section ----
28.  
29. (defun test:CB ( rtr arg / lockModes limitLength e o h len )
30.  
31.   (and
32.     (or
33.       (wcmatch (last arg) "`#(C:*)")
34.       (vl-some (function (lambda (x) (eq (last arg) (strcat "#" x)))) '("PLINE" "RECTANG"))
35.     )
36.     (setq lockModes (cdr (reverse (cddr arg))))
37.     (or
38.       (apply '= (cons 2 lockModes))
39.       (vl-every (function (lambda (x) (<= 1 x 2))) lockModes)
40.     ); or
41.     (setq e (entlast))
42.     (not (vlax-erased-p e))
43.     (setq o (vlax-ename->vla-object e))
44.     (setq h (vlax-get o 'Handle))
45.     (Rectangle-p e)
46.     (setq len (vlax-curve-getDistAtParam o (vlax-curve-getEndParam o)))
47.     (setq limitLength (cadr (vlr-data rtr)))
48.     (>= len limitLength)
49.     (not (member h (cddr (vlr-data rtr))))
50.     (progn
51.       (vlr-data-set rtr (append (vlr-data rtr) (list h)))
52.       (LM:popup "Warning"
53.         (strcat
54.           "• Warning •"
55.           "\nYou have drawn a rectangle"
56.           "\nWith approx length of " (rtos len 2 2) " units"
57.           (cond
58.             ( (cddr (vlr-data rtr))
59.               (vl-string-right-trim ", " (strcat "\n\nCached handles:\n" (apply 'strcat (mapcar '(lambda (x) (strcat x ", ")) (cddr (vlr-data rtr))))))
60.             )
61.             ("")
62.           ); cond
63.         ); strcat
64.         (+ 0 48 4096)
65.       ); LM:popup
66.     ); progn
67.   ); and
68. ); defun test:CB
69.  
70. ; ------------------------------
71. ; ---- Subfunctions section ----
72.  
73.  
74. ;; Popup  -  Lee Mac
75. ;; A wrapper for the WSH popup method to display a message box prompting the user.
76. ;; ttl - [str] Text to be displayed in the pop-up title bar
77. ;; msg - [str] Text content of the message box
78. ;; bit - [int] Bit-coded integer indicating icon & button appearance
79. ;; Returns: [int] Integer indicating the button pressed to exit
80.  
81. (defun LM:popup ( ttl msg bit / wsh rtn )
82.   (if (setq wsh (vlax-create-object "wscript.shell"))
83.     (progn
84.       (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit)))
85.       (vlax-release-object wsh)
86.       (if (not (vl-catch-all-error-p rtn)) rtn)
87.     )
88.   )
89. )
90.  
91.  
92. ; Rectangle-p - Lee Mac
93. ; http://www.theswamp.org/index.php?topic=40249.msg455137#msg455137
94. (defun Rectangle-p ( ent / elist p1 p2 p3 p4 )
95.   (and
96.     (eq "LWPOLYLINE" (cdr (assoc 0 (setq elist (entget ent))))) ;; Is it an LWPolyline?
97.     (= 4 (cdr (assoc 90 elist))) ;; Does it have 4 vertices?
98.     (= 1 (logand 1 (cdr (assoc 70 elist)))) ;; Is it Closed?
99.     (not (HasBulge elist)) ;; Arc segments?
100.     (mapcar 'set '(p1 p2 p3 p4) ;; Collect the Vertices for further investigation
101.       (apply 'append
102.         (mapcar '(lambda ( pair ) (if (= 10 (car pair)) (list (cdr pair)))) elist)
103.       )
104.     )
105.     (equal (distance p1 p2) (distance p3 p4) 1e-8) ;; Two pairs of
106.     (equal (distance p1 p4) (distance p2 p3) 1e-8) ;; equal sides?
107.     (equal (distance p1 p3) (distance p2 p4) 1e-8) ;; Is it a parallelogram?
108.   )
109. )
110.  
111. (defun HasBulge ( elist / pair )
112.   (and (setq pair (assoc 42 elist))
113.     (or (not (equal 0.0 (cdr pair) 1e-10))
114.       (HasBulge (cdr (member pair elist)))
115.     )
116.   )
117. )

Should work upon invoking commands like "RECTANGLE" or "POLYLINE" (only when a rectangular-p PLINE is drawn) and for test LISP functions like this one:

Code - Auto/Visual Lisp: [Select]

1. (defun C:testDraw ( / size )
2.   (initget (+ 2 4))
3.   (if (setq size (getint "\nInput rectangle size: "))
4.     (
5.       (lambda (L)
6.         (entmakex (append (list (cons 0 "LWPOLYLINE")
7.           (cons 100 "AcDbEntity")
8.           (cons 100 "AcDbPolyline")
9.           (cons 90 (length L))
10.           (cons 70 1)
11.         )
12.         (mapcar (function (lambda (p) (cons 10 p))) L)))
13.       )
14.       (list (list 0 0) (list size 0) (list size size) (list 0 size))
15.     )
16.   )
17. )

Unfortunately it won't store all the rectangles drawn via LISP functions, where the rectangles are drawn within a loop. Like this one -

Code - Auto/Visual Lisp: [Select]

1. (defun C:testDraw2 ( / size )
2.  
3.   (foreach size '(500 600 900 1000 1050)
4.     (
5.       (lambda (L)
6.         (entmakex (append (list (cons 0 "LWPOLYLINE")
7.           (cons 100 "AcDbEntity")
8.           (cons 100 "AcDbPolyline")
9.           (cons 90 (length L))
10.           (cons 70 1)
11.         )
12.         (mapcar (function (lambda (p) (cons 10 p))) L)))
13.       )
14.       (list (list 0 0) (list size 0) (list size size) (list 0 size))
15.     )
16.   )
17. )

Lastly, its not possible to modify the object within the callback (of my code) - like changing its color or erasing it (only read methods are available).

[Lee Mac]

I created a Limited Length Polyline program some time ago, which may be of use.

[martinle]

Hello Grrr1337,
Yes, it works very well for the total length of the rectangle. However, the reactor has to check the individual leg lengths of the polyline and if a length is longer than 2780mm, the alarm should appear.
Thanks for your help!
Martin

[dexus]

Hello Grrr1337,
Yes, it works very well for the total length of the rectangle. However, the reactor has to check the individual leg lengths of the polyline and if a length is longer than 2780mm, the alarm should appear.
Thanks for your help!
Martin

You can replace the total length line:

Code - Auto/Visual Lisp: [Select]

1. (setq len (vlax-curve-getDistAtParam o (vlax-curve-getEndParam o)))

With something that gets the longest segment length:

Code - Auto/Visual Lisp: [Select]

1. (setq end (vlax-curve-getEndParam o)
2.       par (vlax-curve-getStartParam o)
3.       len 0.0)
4. (while (< par end)
5.   (setq len
6.     (max
7.       len
8.       (-
9.         (vlax-curve-getDistAtParam o (setq par (1+ par)))
10.         (vlax-curve-getDistAtParam o (1- par))
11.       )
12.     )
13.   )
14. )

[martinle]

hello dexus,
great this works very well for me!
Thanks for your help.
Now I make fewer mistakes!
Thanks!
Martin

[Grrr1337]

Thank you for the assistance, dexus!

[martinle]

Hello Grrr1337
Can you explain to me what this code does?
Thanks!