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

0 Members and 1 Guest are viewing this topic.

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #45 on: April 22, 2021, 04:13:41 AM »
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.

Christina

  • Newt
  • Posts: 27
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #46 on: April 22, 2021, 12:48:44 PM »
Hello Bigal,

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

Christina

Christina

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


« Last Edit: April 22, 2021, 02:35:39 PM by Christina »

Christina

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

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #49 on: April 22, 2021, 03:59:51 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. 

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #50 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. )
  113. (defun line_ (str_ end_)
  114.   (entmake (list '(0 . "LINE")
  115.                  (cons 10 (trans str_ 1 0))
  116.                  (cons 11 (trans end_ 1 0))
  117.                  (cons 8 "KASTEN")
  118.                  '(6 . "ByLayer")
  119.                  '(62 . 9)
  120.                  '(48 . 3)
  121.            )
  122.   )
  123. )
  124.  

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #51 on: April 23, 2021, 03:12:35 AM »
Just in case this is the latest version.



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)

A man who never made a mistake never made anything

Christina

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

Christina

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

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Draw diagonal hatch lines in rectangle by pick
« Reply #54 on: April 23, 2021, 03:24:33 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.

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.

ronjonp

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

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC