Author Topic: Draw diagonal hatch lines in rectangle by pick  (Read 6822 times)

0 Members and 1 Guest are viewing this topic.

Christina

  • Newt
  • Posts: 27
Draw diagonal hatch lines in rectangle by pick
« 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



ronjonp

  • Needs a day job
  • Posts: 7526
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #1 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. )

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Christina

  • Newt
  • Posts: 27
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #2 on: April 14, 2021, 10:42:46 AM »
OMG - Thank you very much ronjonp!  :smitten:
My day can not be ruined

Christina

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #3 on: April 14, 2021, 10:57:41 AM »
OMG - Thank you very much ronjonp!  :smitten:
My day can not be ruined

Christina
Glad to help :)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Christina

  • Newt
  • Posts: 27
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #4 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

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #5 on: April 14, 2021, 12:01:13 PM »
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.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Christina

  • Newt
  • Posts: 27
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #6 on: April 14, 2021, 01:08:17 PM »
Thank you for thinking about it !

Christina

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #7 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)
  61. (defun line_ (str_ end_) (entmake (list '(0 . "LINE") (cons 10 (trans str_ 1 0)) (cons 11 (trans end_ 1 0)))))
  62.  
« Last Edit: April 15, 2021, 07:21:26 PM by Tharwat »

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #8 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)))))

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #9 on: April 15, 2021, 06:16:28 PM »
Thanks Lee,

Yes that might occur so codes updated to account for such circumstances.
« Last Edit: April 15, 2021, 07:20:57 PM by Tharwat »

Christina

  • Newt
  • Posts: 27
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #10 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

Christina

  • Newt
  • Posts: 27
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #11 on: April 15, 2021, 08:57:35 PM »
And the photo

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #12 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)


« Last Edit: April 16, 2021, 01:38:29 AM by BIGAL »
A man who never made a mistake never made anything

Christina

  • Newt
  • Posts: 27
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #13 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

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #14 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)
  69. (defun line_ (str_ end_) (entmake (list '(0 . "LINE") (cons 10 (trans str_ 1 0)) (cons 11 (trans end_ 1 0)))))
  70.