Jump to content

Layout for an area within an irregularly shaped polygon

CADWORKER

By CADWORKER
in AutoCAD 2D Drafting, Object Properties & Interface

 Share

Recommended Posts

CADWORKER Enthusiast

CADWORKER

Posted
Posted

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.

01_Sheets.jpg

02_Overall Grid.jpg

03_text inside the polygon and trimming lines.jpg

04_Result.jpg

Link to comment
Share on other sites
CADWORKER Enthusiast

CADWORKER

Posted
  • Author
Posted
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.

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 by BIGAL
Link to comment
Share on other sites
lrm Experienced

lrm

Posted
Posted

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.

image.png.93fe5c357c9cf1d45f7411202b87cfe4.png 

 

image.png

Link to comment
Share on other sites
eldon Grand Master

eldon

Posted
Posted

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
*

Link to comment
Share on other sites
Stefan BMR Proficient

Stefan BMR

Posted
Posted (edited)
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)
)

 

Grid.gif.2fd17b85a39d18407a159b427f0a4e26.gif

Edited by Stefan BMR
Changed text position
  • Like 1
  • Thanks 1
Link to comment
Share on other sites
symoin Enthusiast

symoin

Posted
Posted

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.

Link to comment
Share on other sites
Stefan BMR Proficient

Stefan BMR

Posted
Posted
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.

  • Like 1
Link to comment
Share on other sites
Serdar BAŞPINAR Newbie

Serdar BAŞPINAR

Posted
Posted
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)
)

 

Grid.gif.2fd17b85a39d18407a159b427f0a4e26.gif

 

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.

image.png.93fe5c357c9cf1d45f7411202b87cfe4.png 

 

image.png

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?

 

Link to comment
Share on other sites
Serdar BAŞPINAR Newbie

Serdar BAŞPINAR

Posted
Posted (edited)

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.

 

576723747_EkranAlnts.JPG.9d8ccd60e3a9af0195c7412bef4c6a09.JPG

Edited by CADTutor
Body message moved from title
Link to comment
Share on other sites
  • CADTutor changed the title to Layout for an area within an irregularly shaped polygon

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...