Layout for an area within an irregularly shaped polygon

[CADWORKER]

Dear All,

Is there any way of drawing grid lines with values for an area inside a polygon of irregular shape for the profile sheets.

Here I make a overall grid, then move the eating and northing values inside the polygon and then trim the lines outside the polygon.

Is there any shorter process for getting the same results.

Attached are the images for reference.

[mhupp]

Maybe a hatch then change the scale to meet your spacing.

[BIGAL]

If your using layouts then can draw grids on Viewports. Yes code by me.

 

 

[CADWORKER]

12 hours ago, mhupp said:

Maybe a hatch then change the scale to meet your spacing.

Thanks, Then how about the easting and northing coordinates text.

[BIGAL]

Did you look at what I posted ?

 

There is a lot of work that goes into writing the text at the end of grid lines correctly. Finding them all etc.

Edited September 5, 2022 by BIGAL

[CADWORKER]

yes

[lrm]

To simplify the grid creation you can:

1. Create regions from the rectangles.
2. Use UNION to create a single region boundary.
3. Hatch using, for example, ANSI37 at 45°
4. Change scale as needed.
5. Specify origin as needed.

 

 

[eldon]

To use an existing AutoCAD hatch pattern like ANSI137 to give a 100 by 100 unit grid would involve scale factors of 800 or 31.496 depending on imperial or metric versions.

 

Much better to use a grid pattern where the basic spacing of 100 units is easier to deal with.

 

*GRID100, Grid 100 x 100 units
0, 0, 0, 0, 100 
90, 0, 0, 0, 100
*

[Stefan BMR]

On 9/3/2022 at 4:40 PM, CADWORKER said:

Dear All,

Is there any way of drawing grid lines with values for an area inside a polygon of irregular shape for the profile sheets.

Here I make a overall grid, then move the eating and northing values inside the polygon and then trim the lines outside the polygon.

Is there any shorter process for getting the same results.

Hi

Here is a lisp from my archive

Works in WCS and parallel UCS. Z rotation allowed, but not 3D rotation.

Text is inserted in both ends of each line

Text height is 1% of grid spacing.

;Stefan M. 12.02.2018
(defun C:SURVGRID ( /  *error* acdoc acobj dimzin
                       GET_POINTS REMOVE_DUPLICATES SEL_OBJ ROT ADD_GRID
                       e dir msg o a pts
                       a1 a2 x1 x2 y1 y2 p1 p2 int
                  )
  (vl-load-com)
  (setq acobj (vlax-get-acad-object)
        acdoc (vla-get-activedocument acobj)
  )

  (if (= (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
  (setq dimzin (getvar 'dimzin))
  (setvar 'dimzin 8)

  (defun *error* (msg)
    (and msg
      (not (wcmatch (strcase msg) "*EXIT*,*CANCEL*,*ABORT*"))
      (princ (strcat "\nEroare: " msg))
    )
    (setvar 'dimzin dimzin)
    (if (= (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
    (princ)
  )

  ;Get list of polyline vertexes.
  ;Bulged segments are refined with points at max. 5° apart
  (defun get_points (e / a b p q n d l a1)
    (setq e (vlax-ename->vla-object e)
          a (vlax-curve-getstartparam e)
          b (vlax-curve-getendparam e)
          )
    (while (< a b)
      (setq p (vlax-curve-getpointatparam e a)
            q (atan (abs (vla-getbulge e a)))
            n (fix (/ (* 80 q) pi))
            a1 a
      )
      (if (not (equal p (car l) 1e-8)) (setq l (cons p l)))
      (if
        (> n 0)
        (repeat (1- n)
          (setq a1 (+ a1 (/ 1.0 n))
                p (vlax-curve-getpointatparam e a1)
          )
          (if (not (equal p (car l) 1e-8)) (setq l (cons p l)))
        )
      )
      (setq a (1+ a))
    )
    l
  )
  
  (defun remove_duplicates (l / r)
    (while l
      (if
        (not (equal (car l) (car r) 1e-8))
        (setq r (cons (car l) r))
      )
      (setq l (cdr l))
    )
    r
  )

  (defun sel_obj (msg etype / e)
    (setvar 'errno 0)
    (setq e (car (entsel msg)))
    (cond
      ((= (getvar 'errno) 7)
       (princ "\nNothing selected. Try again.")
       (sel_obj msg etype)
      )
      ((not e) nil)
      ((wcmatch (cdr (assoc 0 (entget e))) etype) e)
      (t
       (princ "\nInvalid object. Try again.")
       (sel_obj msg etype)
      )
    )
  )

  (defun rot (p a)
    (list
      (- (* (car p) (cos a)) (* (cadr p) (sin a)))
      (+ (* (car p) (sin a)) (* (cadr p) (cos a)))
    )
  )

  (defun add_grid (p1 p2 str a)
    (entmakex
      (list
       '(0 . "TEXT")
       '(8 . "Grid")
       (cons 10 (mapcar '+ o  (rot (polar p1 (* 0.25 pi) (* (sqrt 2) 0.01 *dist*)) a)))
       (cons 40 (* 0.02 *dist*))
       (cons 1 str)
       (cons 50 a)
       (assoc 41 (tblsearch "style" (getvar 'textstyle)))
       (cons 7 (getvar 'textstyle))
      )
    )
    (entmakex
      (list
       '(0 . "TEXT")
       '(8 . "Grid")
       '(10 0.0 0.0 0.0)
       (cons 40 (* 0.02 *dist*))
       (cons 1 str)
       (cons 50 a)
       (assoc 41 (tblsearch "style" (getvar 'textstyle)))
       (cons 7 (getvar 'textstyle))
       '(72 . 2)
       (cons 11 (mapcar '+ o  (rot (polar p2 (* 0.75 pi) (* (sqrt 2) 0.01 *dist*)) a)))
       '(73 . 0)
      )
    )
    (entmakex
      (list
       '(0 . "LINE") '(8 . "Grid")
        (cons 10 (mapcar '+ o  (rot p1 a)))
        (cons 11 (mapcar '+ o  (rot p2 a)))
      )
    )
  )
  
  (or *dist* (setq *dist* 100.0))

  (if
    (and
      (setq e (sel_obj "\nSelect polyline: " "*POLYLINE"))
      (progn
        (setq dir (if (zerop (getvar 'worlducs)) "Ucs" "Wcs"))
        (initget "Wcs Ucs")
        (setq dir
          (cond
            ((getkword (strcat "\nSpecify origin [Wcs/Ucs] <" dir ">: ")))
            (dir)
          )
        )
      )

      (setq msg "\nUCS is not parallel to WCS.")

      (or
        (eq dir "Wcs")
        (and
          (equal (caddr (getvar 'ucsxdir)) 0.0 1e-8)
          (equal (caddr (getvar 'ucsydir)) 0.0 1e-8)
        )
      )
      
      (if
        (eq dir "Wcs")
        (setq o '(0.0 0.0 0.0)
              a 0.0
        )
        (setq o (getvar 'ucsorg)
              a (angle '(0.0 0.0 0.0) (getvar 'ucsxdir))
              
        )
      )
      
      (setq pts
        (remove_duplicates
          (
            (lambda (l) (cons (last l) l))
            (get_points e)
          )
        )
      )

      (setq msg "\nPolyline is not parallel to WCS.")
      
      ( (lambda (l)
          (vl-every '(lambda (x) (equal (car l) x 1e-8)) l)
        )
        (mapcar 'caddr pts)
      )
      
      (setq pts
        (mapcar
         '(lambda (p)
            (rot (mapcar '- p o) (- a))
          )
          pts
        )
      )

      (setq *dist*
        (cond
          ((getdist (strcat "\nSpecify grid distance <" (rtos *dist*) ">: ")))
          (*dist*)
        )
      )
    )
    (foreach u (list nil (/ pi -2.0))
      (if
        u
        (setq pts (mapcar '(lambda (p) (rot p u)) pts))
        (setq u 0.0)
      )

      (mapcar
       '(lambda (p f) (set p (apply 'mapcar (cons f pts))))
       '(a1 a2) '(min max)
      )
      (setq x1 (- (car  a1) *dist*)
            y1 (* *dist* (fix (/ (cadr a1) *dist*)))
            x2 (+ (car  a2) *dist*)
            y2 (* *dist* (1+ (fix (/ (cadr a2) *dist*))))
      )
      (while
        (<= y1 y2)
        (setq p1 (list x1 y1)
              p2 (list x2 y1)
        )
        (if
          (and
            (setq int (vl-remove nil (mapcar '(lambda (p3 p4) (inters p1 p2 p3 p4 T)) pts (cdr pts))))
            (setq int (vl-sort int '(lambda (a b) (> (car a) (car b)))))
            (setq int (remove_duplicates int))
            (> (length int) 1)
          )
          (while
            (cadr int)
            (add_grid
              (car int)
              (cadr int)
              (if
                (zerop u)
                (strcat "N " (rtos    y1  2 3))
                (strcat "E " (rtos (- y1) 2 3))
              )
              (- a u)
            )
            (setq int (cddr int))
          )
        )
        (setq y1 (+ y1 *dist*))
      )
    )
    (if msg (princ msg))
  )
  (*error* nil)
  (princ)
)

 

Edited September 6, 2022 by Stefan BMR
Changed text position

[symoin]

Dear Mr. Stefan BMR,

THANKS FOR THIS WONDER FUL CODE,

Just a kind request if you could add a space at the start and end of the text values to as it will have a clearance from the limits (boundary line).

I look into your code and can add a space before the text values by replacing "N " to " N ". But could not figure it to add at the end.

 

Once again thanks a lot.

[Stefan BMR]

36 minutes ago, symoin said:

Dear Mr. Stefan BMR,

THANKS FOR THIS WONDER FUL CODE,

Just a kind request if you could add a space at the start and end of the text values to as it will have a clearance from the limits (boundary line).

I look into your code and can add a space before the text values by replacing "N " to " N ". But could not figure it to add at the end.

 

Once again thanks a lot.

 

Code updated in my previous post.

[CADWORKER]

Thanks for all your efforts.

[Serdar BAŞPINAR]

On 9/6/2022 at 7:45 PM, Stefan BMR said:

Hi

Here is a lisp from my archive

Works in WCS and parallel UCS. Z rotation allowed, but not 3D rotation.

Text is inserted in both ends of each line

Text height is 1% of grid spacing.

;Stefan M. 12.02.2018
(defun C:SURVGRID ( /  *error* acdoc acobj dimzin
                       GET_POINTS REMOVE_DUPLICATES SEL_OBJ ROT ADD_GRID
                       e dir msg o a pts
                       a1 a2 x1 x2 y1 y2 p1 p2 int
                  )
  (vl-load-com)
  (setq acobj (vlax-get-acad-object)
        acdoc (vla-get-activedocument acobj)
  )

  (if (= (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
  (setq dimzin (getvar 'dimzin))
  (setvar 'dimzin 8)

  (defun *error* (msg)
    (and msg
      (not (wcmatch (strcase msg) "*EXIT*,*CANCEL*,*ABORT*"))
      (princ (strcat "\nEroare: " msg))
    )
    (setvar 'dimzin dimzin)
    (if (= (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
    (princ)
  )

  ;Get list of polyline vertexes.
  ;Bulged segments are refined with points at max. 5° apart
  (defun get_points (e / a b p q n d l a1)
    (setq e (vlax-ename->vla-object e)
          a (vlax-curve-getstartparam e)
          b (vlax-curve-getendparam e)
          )
    (while (< a b)
      (setq p (vlax-curve-getpointatparam e a)
            q (atan (abs (vla-getbulge e a)))
            n (fix (/ (* 80 q) pi))
            a1 a
      )
      (if (not (equal p (car l) 1e-8)) (setq l (cons p l)))
      (if
        (> n 0)
        (repeat (1- n)
          (setq a1 (+ a1 (/ 1.0 n))
                p (vlax-curve-getpointatparam e a1)
          )
          (if (not (equal p (car l) 1e-8)) (setq l (cons p l)))
        )
      )
      (setq a (1+ a))
    )
    l
  )
  
  (defun remove_duplicates (l / r)
    (while l
      (if
        (not (equal (car l) (car r) 1e-8))
        (setq r (cons (car l) r))
      )
      (setq l (cdr l))
    )
    r
  )

  (defun sel_obj (msg etype / e)
    (setvar 'errno 0)
    (setq e (car (entsel msg)))
    (cond
      ((= (getvar 'errno) 7)
       (princ "\nNothing selected. Try again.")
       (sel_obj msg etype)
      )
      ((not e) nil)
      ((wcmatch (cdr (assoc 0 (entget e))) etype) e)
      (t
       (princ "\nInvalid object. Try again.")
       (sel_obj msg etype)
      )
    )
  )

  (defun rot (p a)
    (list
      (- (* (car p) (cos a)) (* (cadr p) (sin a)))
      (+ (* (car p) (sin a)) (* (cadr p) (cos a)))
    )
  )

  (defun add_grid (p1 p2 str a)
    (entmakex
      (list
       '(0 . "TEXT")
       '(8 . "Grid")
       (cons 10 (mapcar '+ o  (rot (polar p1 (* 0.25 pi) (* (sqrt 2) 0.01 *dist*)) a)))
       (cons 40 (* 0.02 *dist*))
       (cons 1 str)
       (cons 50 a)
       (assoc 41 (tblsearch "style" (getvar 'textstyle)))
       (cons 7 (getvar 'textstyle))
      )
    )
    (entmakex
      (list
       '(0 . "TEXT")
       '(8 . "Grid")
       '(10 0.0 0.0 0.0)
       (cons 40 (* 0.02 *dist*))
       (cons 1 str)
       (cons 50 a)
       (assoc 41 (tblsearch "style" (getvar 'textstyle)))
       (cons 7 (getvar 'textstyle))
       '(72 . 2)
       (cons 11 (mapcar '+ o  (rot (polar p2 (* 0.75 pi) (* (sqrt 2) 0.01 *dist*)) a)))
       '(73 . 0)
      )
    )
    (entmakex
      (list
       '(0 . "LINE") '(8 . "Grid")
        (cons 10 (mapcar '+ o  (rot p1 a)))
        (cons 11 (mapcar '+ o  (rot p2 a)))
      )
    )
  )
  
  (or *dist* (setq *dist* 100.0))

  (if
    (and
      (setq e (sel_obj "\nSelect polyline: " "*POLYLINE"))
      (progn
        (setq dir (if (zerop (getvar 'worlducs)) "Ucs" "Wcs"))
        (initget "Wcs Ucs")
        (setq dir
          (cond
            ((getkword (strcat "\nSpecify origin [Wcs/Ucs] <" dir ">: ")))
            (dir)
          )
        )
      )

      (setq msg "\nUCS is not parallel to WCS.")

      (or
        (eq dir "Wcs")
        (and
          (equal (caddr (getvar 'ucsxdir)) 0.0 1e-8)
          (equal (caddr (getvar 'ucsydir)) 0.0 1e-8)
        )
      )
      
      (if
        (eq dir "Wcs")
        (setq o '(0.0 0.0 0.0)
              a 0.0
        )
        (setq o (getvar 'ucsorg)
              a (angle '(0.0 0.0 0.0) (getvar 'ucsxdir))
              
        )
      )
      
      (setq pts
        (remove_duplicates
          (
            (lambda (l) (cons (last l) l))
            (get_points e)
          )
        )
      )

      (setq msg "\nPolyline is not parallel to WCS.")
      
      ( (lambda (l)
          (vl-every '(lambda (x) (equal (car l) x 1e-8)) l)
        )
        (mapcar 'caddr pts)
      )
      
      (setq pts
        (mapcar
         '(lambda (p)
            (rot (mapcar '- p o) (- a))
          )
          pts
        )
      )

      (setq *dist*
        (cond
          ((getdist (strcat "\nSpecify grid distance <" (rtos *dist*) ">: ")))
          (*dist*)
        )
      )
    )
    (foreach u (list nil (/ pi -2.0))
      (if
        u
        (setq pts (mapcar '(lambda (p) (rot p u)) pts))
        (setq u 0.0)
      )

      (mapcar
       '(lambda (p f) (set p (apply 'mapcar (cons f pts))))
       '(a1 a2) '(min max)
      )
      (setq x1 (- (car  a1) *dist*)
            y1 (* *dist* (fix (/ (cadr a1) *dist*)))
            x2 (+ (car  a2) *dist*)
            y2 (* *dist* (1+ (fix (/ (cadr a2) *dist*))))
      )
      (while
        (<= y1 y2)
        (setq p1 (list x1 y1)
              p2 (list x2 y1)
        )
        (if
          (and
            (setq int (vl-remove nil (mapcar '(lambda (p3 p4) (inters p1 p2 p3 p4 T)) pts (cdr pts))))
            (setq int (vl-sort int '(lambda (a b) (> (car a) (car b)))))
            (setq int (remove_duplicates int))
            (> (length int) 1)
          )
          (while
            (cadr int)
            (add_grid
              (car int)
              (cadr int)
              (if
                (zerop u)
                (strcat "N " (rtos    y1  2 3))
                (strcat "E " (rtos (- y1) 2 3))
              )
              (- a u)
            )
            (setq int (cddr int))
          )
        )
        (setq y1 (+ y1 *dist*))
      )
    )
    (if msg (princ msg))
  )
  (*error* nil)
  (princ)
)

 

 

On 9/6/2022 at 4:52 PM, lrm said:

To simplify the grid creation you can:

1. Create regions from the rectangles.
2. Use UNION to create a single region boundary.
3. Hatch using, for example, ANSI37 at 45°
4. Change scale as needed.
5. Specify origin as needed.

 

 

If possible, can you put a separator in the code? so can you revise it as 133 000 instead of 133000 or 74 000 instead of 74000?

 

[Serdar BAŞPINAR]

Dear Friends, Creating a layout for an area within an irregularly shaped polygon for profile pages Is there a shorter process? Attached are pictures for your reference.

 

Edited September 11, 2022 by CADTutor
Body message moved from title

[BIGAL]

You are asking making layouts from along a pline ?

[CADWORKER]

Thanks Bigal,

My request is done by Stefan BMR.