TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Christina on April 14, 2021, 08:35:12 AM

Title: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 14, 2021, 08:35:12 AM
Hello

Searched for a long time, but not found how I know the four points of a rectangle/square to draw diagonal hatch lines by clicking(pick) somewhere in the rectangle.
The rectangle is made by lines and corners are normally 90°.

If someone can give me a hint how to know the points of the corners by picking anywhere in the rectangle, I will search further to draw the diagonals hatch lines!
I want to thank you in advance for reading this!

I have attach example

Christina


Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: ronjonp on April 14, 2021, 10:31:17 AM
Welcome to TheSwamp! Here's an example with some comments:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ _boundary e p)
  2.   ;; RJP » 2021-04-14
  3.   ;; Function to get a boundary from a point (bpoly) locks up my session for some reason
  4.   (defun _boundary (p / e)
  5.     (setq e (entlast))
  6.     (command "_.-boundary" p "")
  7.     (if (not (equal e (entlast)))
  8.       (entlast)
  9.     )
  10.   )
  11.   ;; If we have a point and a boundary is created
  12.   (cond ((and (setq p (getpoint "\nPick an internal point: ")) (setq e (_boundary p)))
  13.          (if (= "SOLID" (cdr (assoc 0 (entget e))))
  14.            (alert "Change boundary type to polyline then run the code again...")
  15.            (progn ;; Get the polyline coordinates
  16.                   (setq p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget e))))
  17.                   ;; Remove our temp boundary
  18.                   (entdel e)
  19.                   ;; Create a line using the first and third point
  20.                   (entmakex (list '(0 . "line") (cons 10 (car p)) (cons 11 (caddr p))))
  21.                   ;; Create a line using the second and fourth point
  22.                   (entmakex (list '(0 . "line") (cons 10 (cadr p)) (cons 11 (cadddr p))))
  23.            )
  24.          )
  25.         )
  26.   )
  27.   (princ)
  28. )
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 14, 2021, 10:42:46 AM
OMG - Thank you very much ronjonp!  :smitten:
My day can not be ruined

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: ronjonp on April 14, 2021, 10:57:41 AM
Quote from: Christina on April 14, 2021, 10:42:46 AM
OMG - Thank you very much ronjonp!  :smitten:
My day can not be ruined

Christina
Glad to help :)
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 14, 2021, 11:47:48 AM
RonJon,
Don't know if I can ask another question, but that's the last one!   :oops:
After pick the rectangle, Lisp asks how many divisions I want on the longest side.
If I type 3 the code divides the rectangle into 3 parts and draws diagonal lines in the 3 parts...

Thanks again for your previous code(very happy)!
Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: ronjonp on April 14, 2021, 12:01:13 PM
Quote from: Christina on April 14, 2021, 11:47:48 AM
RonJon,
Don't know if I can ask another question, but that's the last one!   :oops:
After pick the rectangle, Lisp asks how many divisions I want on the longest side.
If I type 3 the code divides the rectangle into 3 parts and draws diagonal lines in the 3 parts...

Thanks again for your previous code(very happy)!
Christina
Post a picture of what you're trying to explain.
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 14, 2021, 01:08:17 PM
Thank you for thinking about it !

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 15, 2021, 05:48:00 PM
Here is my attempt for your second request and hopefully Ron won't mind.
Code - Auto/Visual Lisp: [Select]
  1. ;; https://www.theswamp.org/index.php?topic=56680.new#new
  2. (defun c:Test ( / old new ins lst pt1 pt2 pt3 pt4 tmp div zro prt hor vrt prt 1pt 2pt)
  3.   ;; Tharwat - Date: 16.Apr.2021        ;;
  4.   (and (or (/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER)))))))
  5.            (alert "Current layer is locked!. unlock then try again")
  6.            )
  7.        (setq old (entlast))
  8.        (setq ins (getpoint "\nSpecify a point in closed area : "))
  9.        (vl-cmdf "_.-boundary" "A" "O" "P" "" "none" ins "")
  10.        (or (not (equal old (setq new (entlast))))
  11.            (command "_.regen")
  12.            (alert "Invalid point. Try again")            
  13.            )
  14.        (progn
  15.          (foreach itm (entget new)
  16.            (and (= (car itm) 10) (setq lst (cons (cdr itm) lst)))
  17.            )
  18.          lst
  19.          )
  20.        (or (and (= 4 (length lst))
  21.                 (setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k)))))
  22.                 (mapcar 'set '(pt1 pt2 pt3 pt4) lst)
  23.                 (or (> (cadr pt2) (cadr pt1))
  24.                     (setq tmp pt1
  25.                           pt1 pt2
  26.                           pt2 tmp)
  27.                     )
  28.                 (or (> (cadr pt4) (cadr pt3))
  29.                     (setq tmp pt3
  30.                           pt3 pt4
  31.                           pt4 tmp)
  32.                     )
  33.                 )
  34.            (and (entdel new)
  35.                 (alert "Invalid polyline was created with more than 4 corners.\nPolyline deleted!")
  36.                 )
  37.            )
  38.        (entdel new)
  39.        (or (initget 6)
  40.            (setq div (getint "\nSpecify number of portions : "))
  41.            )
  42.        (or (and (setq zro (zerop (setq prt (1- div))))
  43.                 (mapcar 'line_ (list pt1 pt2) (list pt4 pt3))
  44.                 )
  45.            (setq hor (distance pt1 pt3)
  46.                  vrt (distance pt1 pt2)
  47.                  prt (/ hor div)
  48.                  )
  49.            )
  50.        (not zro)
  51.        (repeat div
  52.          (setq 1pt (polar pt1 0.0 prt)
  53.                2pt (polar 1pt (* pi 0.5) vrt)
  54.                )
  55.          (mapcar 'line_ (list pt1 pt2) (list 2pt 1pt))
  56.          (or (equal 1pt pt3 1e-4) (line_ 1pt 2pt))
  57.          (setq pt1 1pt pt2 2pt)
  58.          )
  59.        )
  60.   (princ)
  62. (defun line_ (str_ end_) (entmake (list '(0 . "LINE") (cons 10 (trans str_ 1 0)) (cons 11 (trans end_ 1 0)))))
  63.  
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Lee Mac on April 15, 2021, 06:08:42 PM
Good solution Tharwat - just be careful with using the following expression to order the 4 vertices, since if we consider the case of the horizontally oriented rectangle, two pairs of vertices will have the same x-coordinate, and so the order in which such vertices will be sorted is ambiguous - as such, sometimes the diagonal will be pt1-pt4, others it might be pt1-pt3.

Code - Auto/Visual Lisp: [Select]
  1. (setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k)))))
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 15, 2021, 06:16:28 PM
Thanks Lee,

Yes that might occur so codes updated to account for such circumstances.
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 15, 2021, 08:54:15 PM
Hello Tharwat and Lee Mac,

Big Thank you for looking into this problem...  :smitten:
We're almost there, the horizontal rectangle works fine.
Looks like there is something about the angles?
My attachment; photo and dwg file will make it more clear.

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 15, 2021, 08:57:35 PM
And the photo
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: BIGAL on April 16, 2021, 12:29:06 AM
I ran out of time but was taking the approach of pt1-pt4 get vertices,  how many,  then make pt1-1 pt1-2 pt1-3 etc and pt4-1 pt4-2 pt4-3 this way angle of the rectang does not matter. Just make variables as required. Maybe ask Vert or Hor. Make a paired list then play join the dots.

Code: [Select]

; segment rectangs with verts and X.
; By AlanH April 2021

(defun c:zigzag ( / oldsnap pt pt1 pt2 pt3 pt4 ang1 ang2 dist1 dist2 lst lst2 x y )

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq pt (getpoint "\nPick point inside rectang "))

(command "bpoly" pt "")
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(command "erase" (entlast) "")

(setq pt1 (nth 0 co-ord)
  pt2 (nth 1 co-ord)
  pt3 (nth 2 co-ord)
  pt4 (nth 3 co-ord)
  ang1 (angle pt1 pt2)
  ang2 (angle pt4 pt3)
  dist1 (distance pt1 pt2)
  dist2 (distance pt4 pt3)
)

(setq num (getreal "\Enter number of segments "))

(setq lst '())
(setq lst2 '())

(setq x 1.0)
(repeat (- (fix num) 1)
(setq lst  (cons (polar pt1 ang1 (* dist1 (/ x num))) lst))
(setq lst2 (cons (polar pt4 ang2 (* dist2 (/ x num))) lst2))
(setq x (+ x 1))
)
(setq lst  (reverse lst ))
(setq lst2 (reverse lst2))

; verts
(setq y 0)
(repeat (length lst)
(command "line" (nth y lst)(nth y lst2) "")
(setq y (+ y 1))
)

; do ends
(setq y 0)
(command "line" pt1 (nth y lst2) "")
(command "line" pt4 (nth y lst) "")

(setq y (- (length lst) 1))
(command "line" pt2 (nth y lst2) "")
(command "line" pt3 (nth y lst) "")

; do mids
(setq y 0)
(repeat (- (length lst) 1)
(command "line" (nth y lst2) (nth (+ y 1) lst) "")
(command "line" (nth y lst) (nth (+ y 1) lst2) "")
(setq y (+ y 1))
)

(setvar 'osmode oldsnap)
(princ)
)
(c:zigzag)

(http://)
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 16, 2021, 05:56:36 AM
Thank you very much Bigal !
When I look at my photo it looks like AutoCad automatically gives pt1, pt2, pt3 and pt4 to the rectangle according to the direction/angle of the rectangle.
Then the length and direction of the rectangle determines how the diagonals should be?
Wow, this seems a very difficult task...

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 16, 2021, 06:41:10 AM
It seems that you want to have the divisions along the longest segment of the closed polyline, so this how I got it from your different examples and hopefully it is the desired one.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test ( / old new ins lst pt1 pt2 pt3 pt4 tmp ang rot zro prt hor vrt prt 1pt 2pt)
  2.   ;; Tharwat - Date: 16.Apr.2021        ;;
  3.   (and (or (/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER)))))))
  4.            (alert "Current layer is locked!. unlock then try again")
  5.            )
  6.        (setq old (entlast))
  7.        (setq ins (getpoint "\nSpecify a point in closed area : "))
  8.        (vl-cmdf "_.-boundary" "A" "O" "P" "" "none" ins "")
  9.        (or (not (equal old (setq new (entlast))))
  10.            (command "_.regen")
  11.            (alert "Invalid point. Try again")            
  12.            )
  13.        (progn
  14.          (foreach itm (entget new)
  15.            (and (= (car itm) 10) (setq lst (cons (cdr itm) lst)))
  16.            )
  17.          lst
  18.          )
  19.        (or (and (= 4 (length lst))
  20.                 (setq lst (vl-sort lst '(lambda (j k) (< (car j) (car k)))))
  21.                 (mapcar 'set '(pt1 pt2 pt3 pt4) lst)
  22.                 (equal (distance pt1 pt3) (distance pt2 pt4) 1e-4)
  23.                 (or (> (distance pt1 pt3) (distance pt1 pt2))
  24.                     (setq tmp pt2
  25.                           pt2 pt3
  26.                           pt3 tmp)
  27.                     )
  28.                 (or (> (cadr pt2) (cadr pt1))
  29.                     (setq tmp pt1
  30.                           pt1 pt2
  31.                           pt2 tmp)
  32.                     )
  33.                 (or (> (cadr pt4) (cadr pt3))
  34.                     (setq tmp pt3
  35.                           pt3 pt4
  36.                           pt4 tmp)
  37.                     )
  38.                 )
  39.            (and (entdel new)
  40.                 (alert "Invalid polyline was created with more than 4 corners.\nPolyline deleted!")
  41.                 )
  42.            )
  43.        (entdel new)
  44.        (or *div:nums* (setq *div:nums* 3))
  45.        (or (initget 6)
  46.            (setq *div:nums* (cond ((getint (strcat "\nSpecify number of portions < " (itoa *div:nums*) " > : "))) (*div:nums*)))
  47.            )
  48.        (or (and (setq zro (zerop (setq prt (1- *div:nums*))))
  49.                 (mapcar 'line_ (list pt1 pt2) (list pt4 pt3))
  50.                 )
  51.            (setq hor (distance pt1 pt3)
  52.                  vrt (distance pt1 pt2)
  53.                  prt (/ hor *div:nums*)
  54.                  ang (angle pt1 pt2)
  55.                  rot (angle pt1 pt3)
  56.                  )
  57.            )
  58.        (not zro)
  59.        (repeat *div:nums*
  60.          (setq 1pt (polar pt1 rot prt)
  61.                2pt (polar 1pt ang vrt)
  62.                )
  63.          (mapcar 'line_ (list pt1 pt2) (list 2pt 1pt))
  64.          (or (equal 1pt pt3 1e-4) (line_ 1pt 2pt))
  65.          (setq pt1 1pt pt2 2pt)
  66.          )
  67.        )
  68.   (princ)
  70. (defun line_ (str_ end_) (entmake (list '(0 . "LINE") (cons 10 (trans str_ 1 0)) (cons 11 (trans end_ 1 0)))))
  71.  
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: ronjonp on April 16, 2021, 12:28:09 PM
Quote from: Christina on April 15, 2021, 08:57:35 PM
And the photo
Just curious, in what profession do you use these 'x' boxes?
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: ronjonp on April 16, 2021, 12:28:59 PM
Quote from: Tharwat on April 15, 2021, 05:48:00 PM
Here is my attempt for your second request and hopefully Ron won't mind.
...
Not at all :)
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 16, 2021, 08:32:41 PM
Hello Tharwat,
Much appreciate your effort!
I have been testing a lot and only a few times it went wrong. But I am very satisfied!
Here is a photo just to be sure because you may know why it can go wrong?
It only happens with a standing rectangle, straight with 4 angles of 90 °.
Cannot reproduce the error it happened spontaneously... with the same error over and over; the zigzag goes to the right as shown in the picture.
But like I said, no problem for me!
Would like to thank you all very much!  :smitten:

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 16, 2021, 08:56:51 PM
Quote
Just curious, in what profession do you use these 'x' boxes?

Hello Ron,
I use it to draw cabinets on my floor plans. I am a student in the healthcare sector but I have become addicted to 3D Architecture.  :idiot2:
Every month I draw a new dream passive house, haha Export it to Sketchup to calculate the shadow's and render it in Enscape or Cinema4D.
Attached a photo with your  x boxes...

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: domenicomaria on April 17, 2021, 01:27:45 AM
https://drive.google.com/file/d/1U0RsF5Y8_6r3pMVMZ5oSLmwnf8HYAKx6/view?usp=sharing

however, you can do, more or less, the same thing, just by using a dynamic block.

A limitation of dynamic blocks is that
it is not possible to change the distance between columns or rows of the "ARRAY" action.

Or rather, it can only be done when you design the dynamic block.

But this is not possible at "run time".

To get around this problem,
you have to MANUALLY scale (with the SCALE command) the block
so that it has the width you need
and then it's all easy.

Just play with it a little bit, and you'll see.

. . . And you will notice that there is also an alignment grip.

If you don't already know it, you will find it interesting!

ciao
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 17, 2021, 02:22:29 AM
Quote from: Christina on April 16, 2021, 08:32:41 PM
Hello Tharwat,
Much appreciate your effort!
I have been testing a lot and only a few times it went wrong. But I am very satisfied!
Here is a photo just to be sure because you may know why it can go wrong?
It only happens with a standing rectangle, straight with 4 angles of 90 °.
Cannot reproduce the error it happened spontaneously... with the same error over and over; the zigzag goes to the right as shown in the picture.
You're welcome.

Can you please share that part of the drawing where the program fails to produce the correct shape ?
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: domenicomaria on April 17, 2021, 03:19:18 AM
Quote
Can you please share that part of the drawing where the program fails to produce the correct shape ?

Maybe you need only to set OSMODE=0
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 17, 2021, 03:25:05 AM
Quote from: domenicomaria on April 17, 2021, 03:19:18 AM
Quote
Can you please share that part of the drawing where the program fails to produce the correct shape ?

Maybe you need only to set OSMODE=0
Its not a matter of guessing.  :no:
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: domenicomaria on April 17, 2021, 03:25:33 AM
I added a FLIP GRIP and ACTION
to CHANGE easily the ARRAY DIRECTION . . .
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: domenicomaria on April 17, 2021, 03:27:17 AM
Quote
Its not a matter of guessing.

to understand, sometimes you need to make assumptions. . .
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 17, 2021, 03:32:26 AM
Quote from: domenicomaria on April 17, 2021, 03:27:17 AM
Quote
Its not a matter of guessing.

to understand, sometimes you need to make assumptions. . .
Why to guess since the codes in front of you that you can read to know if your expectation was right ?
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: domenicomaria on April 17, 2021, 04:01:05 AM
Quote
Why to guess since the codes in front of you that you can read to know if your expectation was right ?

I have read your code and it seems to me that there are no problems. . .
. . . but maybe you are right. . .
. . . there can be many reasons that produce an error. . .
. . . and that at first sight, they are not considered. . .

. . . mine was just a hypothesis . . .
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: domenicomaria on April 17, 2021, 08:20:38 AM
in retrospect,
I believe that the error is due to the fact that
the points that define the upper short segment
are for some reason reversed . . .
 
. . . I think this, observing  the kind of mistake
Christina pointed out in the attached image.

in fact, the angle of the long segment is wrong
and it is instead that of the diagonal of the rectangle. . .
. . .
so the problem is:
what happens when you acquire
and process the boundary points?
. . .
maybe you should make sure that
the 4 segments of the rectangle
(obtained from your 4 processed points)
do not intersect with each other
. . .
and to always get the same behavior,
you should know whether the direction of the point list
is clockwise or anti-clockwise
. . .
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 17, 2021, 09:31:46 AM
Hello Domenicomaria,

Your information about the dynamic blocks seems very interesting to me and I will have a good look at how something like this works.
But for me it is all about the code of the experts here because I can make some small additions to it. After that  I work out everything in OpenDCL so that I have a nice tool with all the bells and my whistles. In the picture you can see what I mean; with this tool I make my stairs.
When i press on a label or textbox, I get an image on the right with all the necessary explanations ... very important for me because i can be so stupid.

Thank you for the info!

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 17, 2021, 09:53:09 AM
Quote
Can you please share that part of the drawing where the program fails to produce the correct shape ?

Hello Tharwat,

I have test it approximately 700 times  :crazy2:
And got only 3 errors... these are different to the previous one.
But for me its a dream code  :smitten:
I am using Acad 2022...

Thank you for your time!

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 17, 2021, 10:49:59 AM
Actually there is nothing special in the codes to make not to work as expected so here is a full test.

I assume that you used the second version from this post:
https://www.theswamp.org/index.php?topic=56680.msg604290#msg604290 (https://www.theswamp.org/index.php?topic=56680.msg604290#msg604290)

Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 17, 2021, 11:28:52 AM
Hello Tharwat,

I reload the second code just in case!
Now gave an error after the third entry...
But don't mind I just press undo and can continue for longer time.
If I only get that error, then I better switch back to Acad 2021 to be on the safe side.

Hope you have a nice weekend and thank you!

Christina

Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 17, 2021, 12:45:29 PM
Hello Tharwat,

Think I can reproduce the error ...
Can you make a normal zigzag in these 2 squares?
With me that does not work even not with 1 zigzag!
If I turn a square 1/4 around, a normal zigzag will work well...   :smitten:

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 17, 2021, 01:37:12 PM
Hello Tharwat,

Another one, if I click left at the top, the zigzag usually works.
If do the same on the bottom right will not work well ...
If everything works well for you, I will go back to Acad 2021!
Thank you to test it  :smitten:

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 17, 2021, 06:27:48 PM
It would be a great idea to consider a few fees then I will develop it further based on your request, PM if you're interested.
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: BIGAL on April 17, 2021, 07:03:38 PM
Using the different method just added the use longest. Would appreciate if you could try it. It will work with trapezoid. used your dwg test63 to test just polar arrayed the 4 lines.

Code: [Select]
; segment rectangs with verts and X.
; By AlanH April 2021

(defun c:zigzag ( / oldsnap pt pt1 pt2 pt3 pt4 ang1 ang2 dist1 dist2 lst lst2 x y )

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq pt (getpoint "\nPick point inside rectang "))

(command "bpoly" pt "")
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(command "erase" (entlast) "")

(setq pt1 (nth 0 co-ord)
  pt2 (nth 1 co-ord)
  pt3 (nth 2 co-ord)
  pt4 (nth 3 co-ord)
  ang1 (angle pt1 pt2)
  ang2 (angle pt4 pt3)
  dist1 (distance pt1 pt2)
  dist2 (distance pt4 pt3)
)

(if (> dist1 dist2)
(setq co-ord (list (nth 1 co-ord)(nth 2 co-ord)(nth 3 co-ord)(nth 0 co-ord)))
)


(setq num (getreal "\Enter number of segments "))

(setq lst '())
(setq lst2 '())

(setq x 1.0)
(repeat (- (fix num) 1)
(setq lst  (cons (polar pt1 ang1 (* dist1 (/ x num))) lst))
(setq lst2 (cons (polar pt4 ang2 (* dist2 (/ x num))) lst2))
(setq x (+ x 1))
)
(setq lst  (reverse lst ))
(setq lst2 (reverse lst2))

; verts
(setq y 0)
(repeat (length lst)
(command "line" (nth y lst)(nth y lst2) "")
(setq y (+ y 1))
)

; do ends
(setq y 0)
(command "line" pt1 (nth y lst2) "")
(command "line" pt4 (nth y lst) "")

(setq y (- (length lst) 1))
(command "line" pt2 (nth y lst2) "")
(command "line" pt3 (nth y lst) "")

; do mids
(setq y 0)
(repeat (- (length lst) 1)
(command "line" (nth y lst2) (nth (+ y 1) lst) "")
(command "line" (nth y lst) (nth (+ y 1) lst2) "")
(setq y (+ y 1))
)

(setvar 'osmode oldsnap)
(princ)
)
(c:zigzag)
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: BIGAL on April 17, 2021, 07:10:03 PM
I was impressed by your stair DCL just 1 question does it check the rise/run rules for stairs ?

This is plain Autocad developed 1990's still available very cheap PM me.

Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 18, 2021, 07:07:31 AM
Quote
It would be a great idea to consider a few fees

Hello Tharwat,
Just a rational thought...
Many employees come to a forum asking for code to impress their boss.
As a result, they can get their job done faster and the boss benefits more... and all looks very happy.   :laugh:
It is therefore easily (for me) understandable that you ask them for a fees.
But can we applies this to a student who is still at school?  :thinking:
Of course you never know who ask for help...

Anyway, thank you for your offer, I'll think about how I can get money.
And thank you very much for your hard work!

Christina

Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 18, 2021, 07:37:26 AM
Hi,
My second version of the program provided works for me in all circumstances and I already recorded a quick demo showing that the program also works on the drawing you attached where the program failed for you.

The program is somehow simple and straight forward the aim that it was wrote for, so how can I modify it for you since it is working properly all the time for me?

Are you adding any codes or adding my codes to another program ?
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 18, 2021, 09:26:21 AM
Hello Bigal,

Quote
Would appreciate if you could try it

Thank you very much for your code it works with all my tests so also Test63!
But sadly the zigzags are on the short and not on the long side.
And 1 zigzag/segment  is not possible...

Quote
just 1 question does it check the rise/run rules for stairs ?
First there is a difference between DCL and OpenDCL...
Yes, i use the formula step-modulus (from my country) and everything is automatic.
When I lower or increase the 15 steps, I see when the staircase is optimal. In the photo, 63.06 cm is bit too high and will be showing in the color red; 15 steps are in this example not 100 % optimal... but still OK of course.
I write the stair data and colors also to a ini file as defaults.
You can see the results in the image but its still work in progress...

Quote
This is plain Autocad developed 1990's still available very cheap PM me.

Very nice but I don't use AutoCad for 3D work, the renders aren't realistic enough for me.
I consider myself more has a 3D artist?
Thank you for all

Christina


Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 18, 2021, 09:56:57 AM
Hello Tharwat,

Quote
My second version of the program provided works for me in all circumstances and I already recorded a quick demo showing that the program also works on the drawing you attached where the program failed for you.

Yes, you really did your best and admire you a lot!  :smitten:
Solving a problem that pops up now and then and works for some people and not are a deadly challenge...
Bigal's code works in TEST63 and TEST45 but does not take a long side and 1 segment.
So, my logic tells me that the fault lies with me and need to reinstall my Windows and AutoCad because the problem will also continue with fees. If there are still problems afterwards, my mom will borrow me little money and will contact you.
Thank you again for what you did!

Christina

Edit: For all the tests i use your original code!


Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 18, 2021, 11:03:37 AM
Quote from: Christina on April 18, 2021, 09:56:57 AM
Solving a problem that pops up now and then and works for some people and not are a deadly challenge...
Just wondering whom these people are?

Quote from: Christina on April 18, 2021, 09:56:57 AM
So, my logic tells me that the fault lies with me and need to reinstall my Windows and AutoCad because the problem will also continue with fees.
I believe the problem has nothing to do with Windows nor AutoCAD.
Quote from: Christina on April 18, 2021, 09:56:57 AM
my mom will borrow me little money and will contact you.
Please do not, I don't like to feel guilty against anyone, so I will never accept that.

Have a good weekend.
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 18, 2021, 12:40:50 PM
Quote
Just wondering whom these people are?

Hello Tharwat,
A good example now is AutoCad 2022!
Some people have problems with slow mouse movement and some not!
I needed to enter GFXDX12 into the command line and set that to 0 to switch from DirectX 12 to 11.

Quote
I believe the problem has nothing to do with Windows nor AutoCAD.
I believe you, but I work in steps and will be sure that Win + Acad are no longer my problem.

Yes, have a good weekend Tharzat
Christina


Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 21, 2021, 07:45:14 PM
Hello Tharwat,

I reinstalled Windows and AutoCAD and the errors keep coming ... so you were right.
Studied all the code I received and mixed it together to form the bulletproof cocktail for my computer.
The code is not 100% correct and is not elegant but does what it should do.

Thank you all for the hard work!  :smitten:

Christina


Code - Auto/Visual Lisp: [Select]
  1. (defun c:Kasten ( / *error* *aantal* oldsnap oldlayer old tmp pt pt1 pt2 pt3 pt4 ang1 ang2 ang3 ang4 dist1 dist2 dist3 dist4 lst1 lst2 x y )
  2.         (defun *error*(msg)
  3.                 (setq *error* nil)
  4.                 (princ)
  5.         )
  6.         (if (not (and (tblsearch "layer" "KASTEN")(tblsearch "ltype" "DASHED2")))
  7.                 (progn
  8.                         (setq oldlayer (getvar "CLAYER")) ;get the current first
  9.                         (alert "No Kasten layer and or DASHED2, will be created.")
  10.                         (command "_.Layer" "_make" "KASTEN" "_ltype" "DASHED2" "6" "")
  11.                 )
  12.         )
  13.  
  14.         (setq oldsnap (getvar 'osmode))                                                
  15.         ;(setvar 'osmode 0)                                                                    
  16.         (setq old (entlast))
  17.         (setq pt (getpoint "\nPick point inside rectang "))    
  18.         (command "bpoly" pt "")                                        
  19.         (setq co_ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
  20.        
  21.         (or (not (equal old (setq new (entlast))))
  22.                 (command "_.regen")
  23.                 (alert "Invalid point. Try again")  
  24.                 (exit)
  25.         )
  26.        
  27.         (progn
  28.                 (foreach itm (entget new)
  29.                         (and (= (car itm) 10) (setq lst1 (cons (cdr itm) lst1)))
  30.                 )
  31.                 lst1
  32.         )
  33.         (or (and (= 4 (length lst1))
  34.                 (setq lst1 (vl-sort lst1 '(lambda (j k) (< (car j) (car k)))))
  35.                         (mapcar 'set '(pt1 pt2 pt3 pt4) lst1)
  36.                         (equal (distance pt1 pt3) (distance pt2 pt4) 1e-4)
  37.                         (or (> (distance pt1 pt3) (distance pt1 pt2))
  38.                                 (setq tmp pt2
  39.                                         pt2 pt3
  40.                                         pt3 tmp
  41.                                 )
  42.                         )
  43.                         (or (> (cadr pt2) (cadr pt1))
  44.                                 (setq tmp pt1
  45.                                         pt1 pt2
  46.                                         pt2 tmp
  47.                                 )
  48.                         )
  49.                         (or (> (cadr pt4) (cadr pt3))
  50.                                 (setq tmp pt3
  51.                                         pt3 pt4
  52.                                         pt4 tmp)
  53.                         )
  54.                 )
  55.                 (and (entdel new)
  56.                         (progn
  57.                                 (alert "Invalid polyline has not 4 corners!")
  58.                                 (exit)
  59.                         )
  60.                 )
  61.         )
  62.        
  63.        
  64.         ;(command "erase" (entlast) "")
  65.         (entdel new)                                   
  66.        
  67.         (setq
  68.                 pt1 (nth 0 co_ord)                             
  69.                 pt2 (nth 1 co_ord)                             
  70.                 pt3 (nth 2 co_ord)                             
  71.                 pt4 (nth 3 co_ord)                             
  72.                
  73.                 ang1 (angle pt4 pt1)           
  74.                 ang2 (angle pt3 pt2)           
  75.                 dist1 (distance pt1 pt4)       
  76.                 dist2 (distance pt2 pt3)       
  77.                
  78.                 ang3 (angle pt1 pt2)           
  79.                 ang4 (angle pt4 pt3)           
  80.                 dist3 (distance pt1 pt2)       
  81.                 dist4 (distance pt4 pt3)               
  82.         )
  83.        
  84.         (If (> dist1 dist3)    
  85.                 (progn                                                 
  86.                         ;(princ "Vertical")
  87.                         (princ "\n 1 = ")(princ (/ (distance pt1 pt4) 1))       ;      2 _ dist3_ 1
  88.                         (princ "\n 2 = ")(princ (/ (distance pt1 pt4) 2))       ;          |        |
  89.                         (princ "\n 3 = ")(princ (/ (distance pt1 pt4) 3))       ;          |        |
  90.                         (princ "\n 4 = ")(princ (/ (distance pt1 pt4) 4))       ;          |        |
  91.                         (princ "\n 5 = ")(princ (/ (distance pt1 pt4) 5))       ; dist2|        |dist1
  92.                         (princ "\n 6 = ")(princ (/ (distance pt1 pt4) 6))       ;          |        |
  93.                         (princ "\n 7 = ")(princ (/ (distance pt1 pt4) 7))       ;          |        |
  94.                         (princ "\n 8 = ")(princ (/ (distance pt1 pt4) 8))       ;          |        |
  95.                         (princ "\n 9 = ")(princ (/ (distance pt1 pt4) 9))       ;           --------
  96.                         (princ)                                                                 ;      3   dist4  4
  97.                 )
  98.                 (progn                                                 
  99.                         ;(princ "Horizontal")
  100.                         (princ "\n 1 = ")(princ (/ (distance pt1 pt2) 1))       ;      2 __dist3__ 1
  101.                         (princ "\n 2 = ")(princ (/ (distance pt1 pt2) 2))       ;         |                |
  102.                         (princ "\n 3 = ")(princ (/ (distance pt1 pt2) 3))       ; dist2|                |dist1
  103.                         (princ "\n 4 = ")(princ (/ (distance pt1 pt2) 4))       ;         |                |
  104.                         (princ "\n 5 = ")(princ (/ (distance pt1 pt2) 5))       ;         ---------------
  105.                         (princ "\n 6 = ")(princ (/ (distance pt1 pt2) 6))       ;         3   dist4    4
  106.                         (princ "\n 7 = ")(princ (/ (distance pt1 pt2) 7))       ;          
  107.                         (princ "\n 8 = ")(princ (/ (distance pt1 pt2) 8))       ;          
  108.                         (princ "\n 9 = ")(princ (/ (distance pt1 pt2) 9))       ;
  109.                         (princ)
  110.                 )
  111.         )
  112.                
  113.         (or *aantal* (setq *aantal* 1))
  114.         (or (initget 6)
  115.                 (setq *aantal* (cond ((getint (strcat "\nAantal indelingen < " (itoa *aantal*) " > : "))) (*aantal*)))
  116.         )
  117.         (setq lst1 '())
  118.         (setq lst2 '())
  119.         (setq x 1.0)
  120.        
  121.         (If (= *aantal* 1)
  122.                 (progn
  123.                         (setq lst1 (cons (polar pt4 ang1 (* dist1 (/ x *aantal*))) lst1))
  124.                         (setq lst2 (cons (polar pt3 ang2 (* dist2 (/ x *aantal*))) lst2))
  125.                         (setq y (- (length lst1) 1))
  126.                         (line_  pt4 (nth y lst2))
  127.                         (line_  pt3 (nth y lst1))
  128.                 )
  129.                 (progn
  130.                         (If (> dist1 dist3)
  131.                                 (progn
  132.                                         (repeat (- (fix *aantal*) 1)   
  133.                                                 (setq lst1 (cons (polar pt4 ang1 (* dist1 (/ x *aantal*))) lst1))
  134.                                                 (setq lst2 (cons (polar pt3 ang2 (* dist2 (/ x *aantal*))) lst2))
  135.                                                 (setq x (+ x 1))
  136.                                         )
  137.                                         (setq y 0)
  138.                                         (repeat (length lst1)
  139.                                                 (line_ (nth y lst1)(nth y lst2))
  140.                                                 (setq y (+ y 1))
  141.                                         )
  142.                                         (setq y 0)
  143.                                         (line_  pt1 (nth y lst2))
  144.                                         (line_  pt2 (nth y lst1))
  145.                                         (setq y (- (length lst1) 1))
  146.                                         (line_  pt4 (nth y lst2))
  147.                                         (line_  pt3 (nth y lst1))
  148.                                         (setq y 0)
  149.                                         (repeat (- (length lst1) 1)
  150.                                                 (line_ (nth y lst2) (nth (+ y 1) lst1))
  151.                                                 (line_ (nth y lst1) (nth (+ y 1) lst2))
  152.                                                 (setq y (+ y 1))
  153.                                         )
  154.                                 )
  155.                                 (progn
  156.                                         (repeat (- (fix *aantal*) 1)
  157.                                                 (setq lst1  (cons (polar pt1 ang3 (* dist3 (/ x *aantal*))) lst1))             
  158.                                                 (setq lst2 (cons (polar pt4 ang4 (* dist4 (/ x *aantal*))) lst2))
  159.                                                 (setq x (+ x 1))
  160.                                         )
  161.                                         (setq y 0)
  162.                                         (repeat (length lst1)
  163.                                                 (line_ (nth y lst1) (nth y lst2))
  164.                                                 (setq y (+ y 1))
  165.                                         )
  166.                                         (setq y 0)
  167.                                         (line_  pt2 (nth y lst2))
  168.                                         (line_  pt3 (nth y lst1))
  169.                                         (setq y (- (length lst1) 1))
  170.                                         (line_  pt1 (nth y lst2))
  171.                                         (line_  pt4 (nth y lst1))
  172.                                         (setq y 0)
  173.                                         (repeat (- (length lst1) 1)
  174.                                                 (line_ (nth y lst2) (nth (+ y 1) lst1))
  175.                                                 (line_ (nth y lst1) (nth (+ y 1) lst2))
  176.                                                 (setq y (+ y 1))
  177.                                         )
  178.                                 )
  179.                         )
  180.                 )
  181.         )
  182.         ;(setvar 'osmode oldsnap)
  183.         (setvar "CLAYER" oldlayer)
  184.         (princ)
  185. )
  186.  
  188.  
  189. (defun line_ (str_ end_)
  190.         (entmakex
  191.                 (list
  192.                         '(0 . "LINE")
  193.                         (cons 10 (trans str_ 1 0))
  194.                         (cons 11 (trans end_ 1 0))
  195.                         (cons 6 "DASHED2")     
  196.                         (cons 62 9)                                            
  197.                         (cons 48 3)                                    
  198.                 )
  199.         )
  200.         (setvar "LTSCALE" 3)                                   
  201. )




Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: BIGAL on April 21, 2021, 08:19:00 PM
Here is my method uses longest side and supports 1 X. Interested to know how it goes in 2022.

Code: [Select]
(defun c:zigzag ( / oldsnap pt pt1 pt2 pt3 pt4 ang1 ang2 dist1 dist2 lst lst2 x y )

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq pt (getpoint "\nPick point inside rectang "))

(command "bpoly" pt "")
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(command "erase" (entlast) "")

(setq pt1 (nth 0 co-ord)
  pt2 (nth 1 co-ord)
  pt3 (nth 2 co-ord)
  pt4 (nth 3 co-ord)
  ang1 (angle pt1 pt2)
  ang2 (angle pt4 pt3)
  dist1 (distance pt1 pt2)
  dist2 (distance pt4 pt3)
)

(if (> dist1 dist2)
(setq co-ord (list (nth 1 co-ord)(nth 2 co-ord)(nth 3 co-ord)(nth 0 co-ord)))
)

(setq num (getreal "\Enter number of segments "))

(if (> num 1)
(progn
(setq lst '())
(setq lst2 '())

(setq x 1.0)
(repeat (- (fix num) 1)
(setq lst  (cons (polar pt1 ang1 (* dist1 (/ x num))) lst))
(setq lst2 (cons (polar pt4 ang2 (* dist2 (/ x num))) lst2))
(setq x (+ x 1))
)
(setq lst  (reverse lst ))
(setq lst2 (reverse lst2))


; do ends
(setq y 0)
(command "line" pt1 (nth y lst2) "")
(command "line" pt4 (nth y lst) "")

(setq y (- (length lst) 1))
(command "line" pt2 (nth y lst2) "")
(command "line" pt3 (nth y lst) "")

; verts
(setq y 0)
(repeat (length lst)
(command "line" (nth y lst)(nth y lst2) "")
(setq y (+ y 1))
)

; do mids
(setq y 0)
(repeat (- (length lst) 1)
(command "line" (nth y lst2) (nth (+ y 1) lst) "")
(command "line" (nth y lst) (nth (+ y 1) lst2) "")
(setq y (+ y 1))
)
)
(progn
(Command "line" (nth 0 co-ord)(nth 2 co-ord) "")
(Command "line" (nth 1 co-ord)(nth 3 co-ord) "")
)
)

(setvar 'osmode oldsnap)
(princ)
)
(c:zigzag)
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 22, 2021, 04:13:41 AM
Quote from: Christina on April 21, 2021, 07:45:14 PM
Studied all the code I received and mixed it together to form the bulletproof cocktail for my computer.
The code is not 100% correct and is not elegant but does what it should do.

I have asked you before if you added any codes to mine but you ignored my question ! so you should have mentioned that clearly from the first time you faced that error which related to your additions and NOT to my codes.

Honesty is required all the time even if we are hidden behind our screens.
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 22, 2021, 12:48:44 PM
Hello Bigal,

Thank you very much!  :smitten:
Will do later much test in 2022.

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 22, 2021, 02:07:09 PM
Quote
Honesty is required all the time even if we are hidden behind our screens.

Hello Tharwat,

Yes, I am an amateur but not that stupid.  :thinking:
You never reply me about the results in TEST63.dwg and TEST45.dwg... take the test and you will also know if your code works.
I tested your original code over 700 times and had about 3 bugs but didn't mind that much.
So, i added some small things such as gray dashed lines... and got of course the same bugs...
Also with new Windows and AutoCAD 2022 I have bugs with your ORIGINAL code.
It is not my fault that your code does not work 100% in version 2022!
Don't wast your time on this kind of innuendo... it will never make your code work better.
You remain an expert in AutoLISP for me and I was able to learn a lot from your code, i have only lucky that my cocktail works well.
So again, thank you very much for your hard work.

Christina


Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 22, 2021, 03:50:45 PM
Hello Bigal,

I have tested much times and also in TEST63 with TEST45 and works great here.
Only problem are still the non-horizontal rectangles (see picture 1).
That's why in my cocktail I had to make a difference between the horizontal and not horizontal with (If (> dist1 dist3) ... and that turned out to work well.
The second picture shows how Autocad gives the points to my rectangles...
If you click not a rectangle or if you have more or less corners than 4, an error occurs.
I was able to solve that with Tharwat's code. Works very well but i cannot do it according the rules of the art.
One zigzag now works too, thank you very much!  :smitten:

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 22, 2021, 03:59:51 PM
Quote from: Christina on April 22, 2021, 02:07:09 PM
You never reply me about the results in TEST63.dwg and TEST45.dwg... take the test and you will also know if your code works.

I don't know how did not I see these drawings ! and I have just seen them after you alluded to them, and yes the routine not performing correctly on them due to the disorder of the coordinates of the newly created polyline.

No worries, I will revise the codes and update it for you. 
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 22, 2021, 05:48:34 PM
Its great that I found a few minutes to revise and update the program before I go to sleep based on the new additions that you already added to the codes that you posted earlier, so here is the updated program and hopefully it would work on all circumstances.

Please note is that the rectangle that is with equal segments, the prorgam would consider the direction of the route horizontally if this make sense to you.

Why did you create the layer "KASTEN" with pink colour [ 6 ] and assigned the line's colour to gray [ 9 ] as well as the LineType also ? although that I assigned the LineType to be ByLayer since the they are the same.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test (/ old new inc ins lst pt1 pt2 pt3 pt4 tmp ang rot zro prt
  2.                hor vrt prt 1pt 2pt)
  3.   ;; Tharwat - Date: 23.Apr.2021        ;;
  4.   (and
  5.     (or (/= 4
  6.             (logand
  7.               4
  8.               (cdr
  9.                 (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER))))
  10.               )
  11.             )
  12.         )
  13.         (alert "Current layer is locked!. unlock then try again")
  14.     )
  15.     (setq old (entlast))
  16.     (setq inc -1
  17.           ins (getpoint "\nSpecify a point in closed area : ")
  18.     )
  19.     (vl-cmdf "_.-boundary" "A" "O" "P" "" "none" ins "")
  20.     (or (not (equal old (setq new (entlast))))
  21.         (command "_.regen")
  22.         (alert "Invalid point. Try again")
  23.     )
  24.     (or
  25.       (and (repeat 4
  26.              (setq inc (1+ inc)
  27.                    lst (cons (vlax-curve-getpointatparam new inc) lst)
  28.              )
  29.            )
  30.            (= 4 (length lst))
  31.            (mapcar 'set '(pt1 pt2 pt3 pt4) (reverse lst))
  32.            (equal (distance pt1 pt3) (distance pt2 pt4) 1e-4)
  33.            (or (and (> (distance pt1 pt4) (distance pt1 pt2))
  34.                     (setq hor (distance pt1 pt2)
  35.                           vrt (distance pt1 pt4)
  36.                           ang (angle pt1 pt2)
  37.                           rot (angle pt1 pt4)
  38.                     )
  39.                )
  40.                (setq tmp pt4
  41.                      pt4 pt2
  42.                      pt2 tmp
  43.                      hor (distance pt1 pt2)
  44.                      vrt (distance pt1 pt4)
  45.                      ang (angle pt1 pt2)
  46.                      rot (angle pt1 pt4)
  47.                )
  48.            )
  49.       )
  50.       (and
  51.         (entdel new)
  52.         (alert
  53.           "Invalid polyline was created with more than 4 corners.\nPolyline deleted!"
  54.         )
  55.       )
  56.     )
  57.     (entdel new)
  58.     (or *div:nums* (setq *div:nums* 3))
  59.     (or (initget 6)
  60.         (setq *div:nums*
  61.                (cond
  62.                  ((getint (strcat "\nSpecify number of portions < "
  63.                                   (itoa *div:nums*)
  64.                                   " > : "
  65.                           )
  66.                   )
  67.                  )
  68.                  (*div:nums*)
  69.                )
  70.         )
  71.     )
  72.     (or (tblsearch "LTYPE" "DASHED2")
  73.         (progn
  74.           (vla-load (vla-get-Linetypes
  75.                       (vla-get-ActiveDocument (vlax-get-acad-object))
  76.                     )
  77.                     "CENTER"
  78.                     "acadiso.lin"
  79.           )
  80.           t
  81.         )
  82.     )
  83.     (or (tblsearch "LAYER" "KASTEN")
  84.         (entmake '((0 . "LAYER")
  85.                    (100 . "AcDbSymbolTableRecord")
  86.                    (100 . "AcDbLayerTableRecord")
  87.                    (2 . "KASTEN")
  88.                    (6 . "DASHED2")
  89.                    (62 . 6)
  90.                    (70 . 0)
  91.                   )
  92.         )
  93.     )
  94.     (or (and (setq zro (zerop (setq prt (1- *div:nums*))))
  95.              (mapcar 'line_ (list pt1 pt2) (list pt3 pt4))
  96.         )
  97.         (setq prt (/ vrt *div:nums*))
  98.     )
  99.     (not zro)
  100.     (repeat *div:nums*
  101.       (setq 1pt (polar pt1 rot prt)
  102.             2pt (polar 1pt ang hor)
  103.       )
  104.       (mapcar 'line_ (list pt1 pt2) (list 2pt 1pt))
  105.       (or (equal 1pt pt4 1e-4) (line_ 1pt 2pt))
  106.       (setq pt1 1pt
  107.             pt2 2pt
  108.       )
  109.     )
  110.   )
  111.   (princ)
  112. )
  114. (defun line_ (str_ end_)
  115.   (entmake (list '(0 . "LINE")
  116.                  (cons 10 (trans str_ 1 0))
  117.                  (cons 11 (trans end_ 1 0))
  118.                  (cons 8 "KASTEN")
  119.                  '(6 . "ByLayer")
  120.                  '(62 . 9)
  121.                  '(48 . 3)
  122.            )
  123.   )
  124. )
  125.  
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: BIGAL on April 23, 2021, 03:12:35 AM
Just in case this is the latest version.

(http://)

Code: [Select]
(defun c:zigzag ( / oldsnap pt pt1 pt2 pt3 pt4 ang1 ang2 dist1 dist2 lst lst2 x y )

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq pt (getpoint "\nPick point inside rectang "))

(command "bpoly" pt "")
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(command "erase" (entlast) "")

(setq pt1 (nth 0 co-ord)
  pt2 (nth 1 co-ord)
  pt3 (nth 2 co-ord)
  pt4 (nth 3 co-ord)
  ang1 (angle pt1 pt2)
  ang2 (angle pt4 pt3)
  dist1 (distance pt1 pt2)
  dist2 (distance pt4 pt3)
)

(if (> dist1 dist2)
(setq co-ord (list (nth 1 co-ord)(nth 2 co-ord)(nth 3 co-ord)(nth 0 co-ord)))
)

(setq num (getreal "\Enter number of segments "))

(if (> num 1)
(progn
(setq lst '())
(setq lst2 '())

(setq x 1.0)
(repeat (- (fix num) 1)
(setq lst  (cons (polar pt1 ang1 (* dist1 (/ x num))) lst))
(setq lst2 (cons (polar pt4 ang2 (* dist2 (/ x num))) lst2))
(setq x (+ x 1))
)
(setq lst  (reverse lst ))
(setq lst2 (reverse lst2))


; do ends
(setq y 0)
(command "line" pt1 (nth y lst2) "")
(command "line" pt4 (nth y lst) "")

(setq y (- (length lst) 1))
(command "line" pt2 (nth y lst2) "")
(command "line" pt3 (nth y lst) "")

; verts
(setq y 0)
(repeat (length lst)
(command "line" (nth y lst)(nth y lst2) "")
(setq y (+ y 1))
)

; do mids
(setq y 0)
(repeat (- (length lst) 1)
(command "line" (nth y lst2) (nth (+ y 1) lst) "")
(command "line" (nth y lst) (nth (+ y 1) lst2) "")
(setq y (+ y 1))
)
)
(progn
(Command "line" (nth 0 co-ord)(nth 2 co-ord) "")
(Command "line" (nth 1 co-ord)(nth 3 co-ord) "")
)
)

(setvar 'osmode oldsnap)
(princ)
)
(c:zigzag)
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 23, 2021, 01:50:06 PM
Hello Tharwat,

Thank you very much, tested extensively almost all day between breaks and have to say that it works perfectly in all situations.
Now I'm going to study all the code better and then try to make fixed layouts with rest and mirror options.
Everything can then go to OpenDCL ...   :smitten:

Quote
Why did you create the layer "KASTEN" with pink colour [ 6 ] and assigned the line's colour to gray [ 9 ] as well as the LineType also ?
The consequences of cutting and pasting and too late in my bed...

Why you don't make nice little tools like my stair example to sell on a website at a nice price?
Or do you already have a webshop?

In the image my planning...

Have a nice weekend Tharwat!

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Christina on April 23, 2021, 02:01:07 PM
Hello Bigal,

In the image the results in ACad 2022...
But don't worry because I have enough code from you all to continue working on my planning!
Thank you very much for all the code you show to me!

And have a nice weekend Bigal!

Christina
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: Tharwat on April 23, 2021, 03:24:33 PM
Quote from: Christina on April 23, 2021, 01:50:06 PM
Thank you very much, tested extensively almost all day between breaks and have to say that it works perfectly in all situations.
Great to hear that.

Quote from: Christina on April 23, 2021, 01:50:06 PM
The consequences of cutting and pasting and too late in my bed...
If you write codes from scratch that would be much better for your learning even you are repeating the same codes in multiple routines, so I believe copy and paste codes will keep you in the back seat no matter how long have you been coding.  :sleezy:

If you have customers that will be interested in that program that you advised me to write and publish then PM me so you can also get a few pieces of that brownies.
Title: Re: Draw diagonal hatch lines in rectangle by pick
Post by: ronjonp on April 23, 2021, 04:46:32 PM
Here are a couple more for fun that use a block instead. One does multiple selection of 4 point polylines and the other internal pick points.
Code - Auto/Visual Lisp: [Select]
  1. ;; Multiple selection
  2. (defun c:foo (/ a d h j p r s w)
  3.   ;; RJP » 2021-04-23
  4.   (defun _makeblk nil
  5.     (cond ((null (tblobjname "block" "_xbox"))
  6.            (entmake '((0 . "BLOCK")
  7.                       (100 . "AcDbEntity")
  8.                       (67 . 0)
  9.                       (8 . "0")
  10.                       (100 . "AcDbBlockReference")
  11.                       (2 . "_xbox")
  12.                       (10 0. 0. 0.)
  13.                       (70 . 0)
  14.                      )
  15.            )
  16.            (entmake '((0 . "LWPOLYLINE")
  17.                       (100 . "AcDbEntity")
  18.                       (67 . 0)
  19.                       (8 . "0")
  20.                       (100 . "AcDbPolyline")
  21.                       (90 . 4)
  22.                       (70 . 1)
  23.                       (10 -0.5 0.5)
  24.                       (10 -0.5 -0.5)
  25.                       (10 0.5 -0.5)
  26.                       (10 0.5 0.5)
  27.                      )
  28.            )
  29.            (entmake '((0 . "LINE")
  30.                       (100 . "AcDbEntity")
  31.                       (67 . 0)
  32.                       (8 . "Dash")
  33.                       (62 . 8)
  34.                       (100 . "AcDbLine")
  35.                       (10 -0.5 0.5 0.)
  36.                       (11 0.5 -0.5 0.)
  37.                      )
  38.            )
  39.            (entmake '((0 . "LINE")
  40.                       (100 . "AcDbEntity")
  41.                       (67 . 0)
  42.                       (8 . "Dash")
  43.                       (62 . 8)
  44.                       (100 . "AcDbLine")
  45.                       (10 0.5 0.5 0.)
  46.                       (11 -0.5 -0.5 0.)
  47.                      )
  48.            )
  49.            (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
  50.           )
  51.     )
  52.     (princ)
  53.   )
  54.   (_makeblk)
  55.   (cond ((and (setq d (getint "\nEnter number to divide: "))
  56.               (setq s (ssget ":L" '((0 . "LWPOLYLINE") (90 . 4))))
  57.          )
  58.          (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
  59.            (setq p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget e))))
  60.            (setq p (mapcar '(lambda (r j) (list (mapcar '/ (mapcar '+ r j) '(2 2 2)) (distance r j)))
  61.                            p
  62.                            (append (cdr p) (list (car p)))
  63.                    )
  64.            )
  65.            ;; Sort long edge
  66.            (and (< (last (car p)) (last (cadr p))) (setq p (reverse p)))
  67.            ;; Long edge length divided by number of x's
  68.            (setq w (/ (last (car p)) d))
  69.            ;; Short edge length
  70.            (setq h (last (cadr p)))
  71.            ;; Angle of short edge midpoints
  72.            (setq a (angle (car (cadr p)) (car (last p))))
  73.            ;; Mid point of short edge
  74.            (setq p (car (cadr p)))
  75.            ;; First block insertion point
  76.            (setq p (polar p a (/ w 2)))
  77.            (repeat d
  78.              (entmake (list '(0 . "INSERT")
  79.                             (assoc 8 (entget e))
  80.                             '(2 . "_xbox")
  81.                             (cons 10 p)
  82.                             (cons 41 w)
  83.                             (cons 42 h)
  84.                             (cons 50 a)
  85.                       )
  86.              )
  87.              (setq p (polar p a w))
  88.            )
  89.          )
  90.         )
  91.   )
  92.   (princ)
  93. )
  94.  
  95. ;; Internal pick
  96. (defun c:foo2 (/ _boundary a d h j r w e p)
  97.   ;; RJP » 2021-04-23
  98.   (defun _makeblk nil
  99.     (cond ((null (tblobjname "block" "_xbox"))
  100.            (entmake '((0 . "BLOCK")
  101.                       (100 . "AcDbEntity")
  102.                       (67 . 0)
  103.                       (8 . "0")
  104.                       (100 . "AcDbBlockReference")
  105.                       (2 . "_xbox")
  106.                       (10 0. 0. 0.)
  107.                       (70 . 0)
  108.                      )
  109.            )
  110.            (entmake '((0 . "LWPOLYLINE")
  111.                       (100 . "AcDbEntity")
  112.                       (67 . 0)
  113.                       (8 . "0")
  114.                       (100 . "AcDbPolyline")
  115.                       (90 . 4)
  116.                       (70 . 1)
  117.                       (10 -0.5 0.5)
  118.                       (10 -0.5 -0.5)
  119.                       (10 0.5 -0.5)
  120.                       (10 0.5 0.5)
  121.                      )
  122.            )
  123.            (entmake '((0 . "LINE")
  124.                       (100 . "AcDbEntity")
  125.                       (67 . 0)
  126.                       (8 . "Dash")
  127.                       (62 . 8)
  128.                       (100 . "AcDbLine")
  129.                       (10 -0.5 0.5 0.)
  130.                       (11 0.5 -0.5 0.)
  131.                      )
  132.            )
  133.            (entmake '((0 . "LINE")
  134.                       (100 . "AcDbEntity")
  135.                       (67 . 0)
  136.                       (8 . "Dash")
  137.                       (62 . 8)
  138.                       (100 . "AcDbLine")
  139.                       (10 0.5 0.5 0.)
  140.                       (11 -0.5 -0.5 0.)
  141.                      )
  142.            )
  143.            (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
  144.           )
  145.     )
  146.     (princ)
  147.   )
  148.   (_makeblk)
  149.   (defun _boundary (p / e)
  150.     (setq e (entlast))
  151.     (command "_.-boundary" p "")
  152.     (if (not (equal e (entlast)))
  153.       (entlast)
  154.     )
  155.   )
  156.   (if (setq d (getint "\nEnter number to divide: "))
  157.     (while (and (setq p (getpoint "\nPick an internal point: ")) (setq e (_boundary p)))
  158.       (if (= "SOLID" (cdr (assoc 0 (entget e))))
  159.         (alert "Change boundary type to polyline then run the code again...")
  160.         (progn (setq p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget e))))
  161.                (setq
  162.                  p (mapcar '(lambda (r j) (list (mapcar '/ (mapcar '+ r j) '(2 2 2)) (distance r j)))
  163.                            p
  164.                            (append (cdr p) (list (car p)))
  165.                    )
  166.                )
  167.                ;; Sort long edge
  168.                (and (< (last (car p)) (last (cadr p))) (setq p (reverse p)))
  169.                ;; Long edge length divided by number of x's
  170.                (setq w (/ (last (car p)) d))
  171.                ;; Short edge length
  172.                (setq h (last (cadr p)))
  173.                ;; Angle of short edge midpoints
  174.                (setq a (angle (car (cadr p)) (car (last p))))
  175.                ;; Mid point of short edge
  176.                (setq p (car (cadr p)))
  177.                ;; First block insertion point
  178.                (setq p (polar p a (/ w 2)))
  179.                (repeat d
  180.                  (entmake (list '(0 . "INSERT")
  181.                                 (assoc 8 (entget e))
  182.                                 '(2 . "_xbox")
  183.                                 (cons 10 p)
  184.                                 (cons 41 w)
  185.                                 (cons 42 h)
  186.                                 (cons 50 a)
  187.                           )
  188.                  )
  189.                  (setq p (polar p a w))
  190.                )
  191.         )
  192.       )
  193.     )
  194.   )
  195.   (princ)
  196. )