Jump to content

Page size wise rectangle drawing lisp

souvik

By souvik
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

souvik Enthusiast

souvik

Posted
Posted

I need a lisp which will draw a rectangle according to a given page size (Like ISO A4, A3, A1) in both landscape and portrait format. Please help me.

Link to comment
Share on other sites
MSasu Grand Master

MSasu

Posted
Posted

You can use this as a start:

; Draw an ISO Format (04-VII-2012)
(defun c:DISOF( / listSize size poz  )
(if (and (not (initget "A4 A3"))
         (setq size (getkword "\nFormat [A4/A3]: "))
         (not (initget "Portrait Landscape"))
         (setq poz  (getkword "\nPozition [Portrait/Landscape]: ")))
 (progn
  (setq listSize (nth (abs (- 4 (atoi (substr size 2))))
                      '((297.0 210.0) (420.0 297.0))))
  (if (= poz "Portrait") (setq listSize (reverse listSize)))
  (command "_RECTANGLE" "_non" '(0.0 0.0) "_non" listSize)
 )
)
(princ)
)

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

The following program will draw the sheet of paper assigned to the current layout, based on the current plot settings for the layout:

 

(defun c:drawpaper ( / l h w )
   (setq l (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
   (vla-getpapersize l 'w 'h)
   (command "_.rectang" "_non" '(0.0 0.0) "_non"
       (if (member (vla-get-plotrotation l) '(0 2))
           (list w h)
           (list h w)
       )
   )
   (princ)
)
(vl-load-com) (princ)

Link to comment
Share on other sites
souvik Enthusiast

souvik

Posted
  • Author
Posted
You can use this as a start:

; Draw an ISO Format (04-VII-2012)
(defun c:DISOF( / listSize size poz  )
(if (and (not (initget "A4 A3"))
         (setq size (getkword "\nFormat [A4/A3]: "))
         (not (initget "Portrait Landscape"))
         (setq poz  (getkword "\nPozition [Portrait/Landscape]: ")))
 (progn
  (setq listSize (nth (abs (- 4 (atoi (substr size 2))))
                      '((297.0 210.0) (420.0 297.0))))
  (if (= poz "Portrait") (setq listSize (reverse listSize)))
  (command "_RECTANGLE" "_non" '(0.0 0.0) "_non" listSize)
 )
)
(princ)
)

 

Thanks this is what I need. But it will be very useful if you kindly add A0 and A1 size with it.

Link to comment
Share on other sites
MSasu Grand Master

MSasu

Posted
Posted

I was hopping that you will try to edit it by yourself. Hint, please pay attention that need to add tem in order, A2, A1 and A0.

Link to comment
Share on other sites
souvik Enthusiast

souvik

Posted
  • Author
Posted (edited)
I was hopping that you will try to edit it by yourself. Hint, please pay attention that need to add tem in order, A2, A1 and A0.

 

I have tried it. Please check..

 

(defun c:DISOF( / listSize size poz  )
(if (and (not (initget "A4 A3 A2 A1"))
         (setq size (getkword "\nFormat [A4/A3/A2/A1]: "))
         (not (initget "Portrait Landscape"))
         (setq poz  (getkword "\nPozition [Portrait/Landscape]: ")))
 (progn
  (setq listSize (nth (abs (- 4 (atoi (substr size 2))))
                      '((297.0 210.0) (420.0 297.0) (594.0 420.0) ( 841.0 594.0))))
  (if (= poz "Portrait") (setq listSize (reverse listSize)))
  (command "_RECTANGLE" "_non" '(0.0 0.0) "_non" listSize)
 )
)
(princ)
)

Edited by souvik
Link to comment
Share on other sites
eldon Grand Master

eldon

Posted
Posted

On a purely practical observation, those are actual sheet sizes and do not have the usual framing offset margin of 15mm. If you try to use those sizes for drawing frames, then you will never be able to plot the drawings with the frames showing to your required scaling.

FrameSize.jpg

Link to comment
Share on other sites
souvik Enthusiast

souvik

Posted
  • Author
Posted
On a purely practical observation, those are actual sheet sizes and do not have the usual framing offset margin of 15mm. If you try to use those sizes for drawing frames, then you will never be able to plot the drawings with the frames showing to your required scaling.

 

Hi Eldon. Sorry for late reply. You are absolutely right. We have to deduct 20mm from the original paper size..

Link to comment
Share on other sites
MSasu Grand Master

MSasu

Posted
Posted

The above code can be adjusted to draw the inner rectangle too:

; Draw an ISO Format (08-VII-2012)
(defun c:DISOF( / listSize size poz border )
(if (and (not (initget "A4 A3 A2 A1 A0"))
         (setq size (getkword "\nFormat [A4/A3/A2/A1/A0]: "))
         (not (initget "Portrait Landscape"))
         (setq poz  (getkword "\nPozition [Portrait/Landscape]: ")))
 (progn
  (setq listSize (nth (abs (- 4 (atoi (substr size 2))))
                      '((297.0 210.0) (420.0 297.0) (594.0 420.0) (841.0 594.0) (1189.0 841.0)))
        border   20.0)
  (if (= poz "Portrait") (setq listSize (reverse listSize)))
  ;;; outer rectangle
  (command "_RECTANGLE" "_non" '(0.0 0.0)
                        "_non" listSize)
  ;;; inner rectangle
  (command "_RECTANGLE" "_non" (list border border)
                        "_non" (list (- (car  listSize) border)
                                     (- (cadr listSize) border)))

  (command "_ZOOM" "_E")
 )
)
(princ)
)

Link to comment
Share on other sites
  • 12 years later...
DELLA MAGGIORA YANN Contributor

DELLA MAGGIORA YANN

Posted
Posted
On 7/8/2012 at 7:43 PM, MSasu said:

Le code ci-dessus peut également être ajusté pour dessiner le rectangle intérieur :

  

; Draw an ISO Format (08-VII-2012)
(defun c:DISOF( / listSize size poz border )
(if (and (not (initget "A4 A3 A2 A1 A0"))
         (setq size (getkword "\nFormat [A4/A3/A2/A1/A0]: "))
         (not (initget "Portrait Landscape"))
         (setq poz  (getkword "\nPozition [Portrait/Landscape]: ")))
 (progn
  (setq listSize (nth (abs (- 4 (atoi (substr size 2))))
                      '((297.0 210.0) (420.0 297.0) (594.0 420.0) (841.0 594.0) (1189.0 841.0)))
        border   20.0)
  (if (= poz "Portrait") (setq listSize (reverse listSize)))
  ;;; outer rectangle
  (command "_RECTANGLE" "_non" '(0.0 0.0)
                        "_non" listSize)
  ;;; inner rectangle
  (command "_RECTANGLE" "_non" (list border border)
                        "_non" (list (- (car  listSize) border)
                                     (- (cadr listSize) border)))

  (command "_ZOOM" "_E")
 )
)
(princ)
)
 

 

hello
thank you for your work...
Would it be possible to insert the iso format where the cursor is?
please
Thanks

Link to comment
Share on other sites
Tsuky Community Regular

Tsuky

Posted
Posted (edited)

 

If this might interest you, try this. This is for a metric system with multiple sizes of A4.

The first use can be confusing, but don't hesitate to move the pointer, if you don't see anything change scale with the + or - keys, or zoom / zoom out with the wheel.

Lines 157 and 158 can be commented out if you want to do other things with the data or continue with your own code... 

(defun des_vec (lst col / lst_sg)
  (setq lst_sg (list (cadr lst) (car lst)))
  (setq lst (cdr lst))
  (while lst
    (if (cadr lst)
      (setq lst_sg (cons (cadr lst) (cons (car lst) lst_sg)))
      (setq lst_sg (cons (last lst_sg) (cons (car lst) lst_sg)))
    )
    (setq lst (cdr lst))
  )
  (setq lst_sg (cons col lst_sg))
  (grvecs lst_sg)
)
(defun c:A4_dyn ( / unit_draw hview old_snapang pt_ins dx dy pt_tmp ang l_scale format_scale coeff key pt_key n nb_column nb_raw pt_row count s_ang)
  (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
    (progn
      (initget "KM ME CM MM")
      (if (not(setq unit_draw (getkword "\nDrawing made in [KM/ME/CM/MM] <ME>: ")))
        (setq unit_draw "ME")
      )
      (cond
        ((eq unit_draw "KM")
          (setq unit_draw 1000000)
        )
        ((eq unit_draw "ME")
          (setq unit_draw 1000)
        )
        ((eq unit_draw "CM")
          (setq unit_draw 10)
        )
        ((eq unit_draw "MM")
          (setq unit_draw 1)
        )
      )
      (setvar "USERS5" (strcat "qz" (itoa unit_draw)))
    )
    (setq unit_draw (atoi (substr (getvar "USERS5") 3)))
  )
  (setq
    hview (getvar "VIEWSIZE")
    old_snapang (getvar "SNAPANG")
    pt_ins (list (- (car (getvar "VIEWCTR")) (* hview 0.5)) (- (cadr (getvar "VIEWCTR")) (* hview 0.5)))
    dx 210.0 dy (* 210.0 (sqrt 2)) pt_tmp pt_ins ang (getvar "SNAPANG")
    l_scale '(1.0 1.25 2.0 2.5 5.0 7.5)
    format_scale (car l_scale)
    coeff 1.0
  )
  (if (> (fix (/ hview dy)) 3)
    (while (> (fix (/ hview dy)) 3)
      (foreach value l_scale
        (if (> (fix (/ hview dy)) 3)
          (setq format_scale value dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale))
        )
      )
      (if (> (fix (/ hview dy)) 3)
        (setq
          coeff (* coeff 10.0)
          l_scale (mapcar '(lambda (x) (* x coeff)) l_scale)
          format_scale (car l_scale)
        )
      )
    )
  )
  (if (< (fix (/ hview dy)) 1)
    (while (< (fix (/ hview dy)) 1)
      (foreach value (reverse l_scale)
        (if (< (fix (/ hview dy)) 1)
          (setq format_scale value dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale))
        )
      )
      (if (< (fix (/ hview dy)) 1)
        (setq
          coeff (* coeff 0.1)
          l_scale (mapcar '(lambda (x) (* x coeff)) l_scale)
          format_scale (last l_scale)
        )
      )
    )
  )
  (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
  (while (and (setq key (grread T 4 0)) (/= (car key) 3))
    (cond
      ((eq (car key) 5)
        (setq pt_key (cadr key))
        (setq n
          (*
            (setq nb_column (fix (/ (+ (* (- (car pt_key) (car pt_ins)) (cos ang)) (* (- (cadr pt_key) (cadr pt_ins)) (sin ang))) dx)))
            (setq nb_raw (fix (/ (- (* (- (cadr pt_key) (cadr pt_ins)) (cos ang)) (* (- (car pt_key) (car pt_ins)) (sin ang))) dy)))
          )
          pt_row pt_ins count 0
        )
        (redraw)
        (repeat n
          (des_vec
            (list
              (list (car pt_ins) (cadr pt_ins))
              (list (+ (car pt_ins) (* dx (cos ang))) (+ (cadr pt_ins) (* dx (sin ang))))
              (setvar "LASTPOINT"
                (list
                  (+ (car pt_ins) (- (* dx (cos ang)) (* dy (sin ang))))
                  (+ (cadr pt_ins) (+ (* dy (cos ang)) (* dx (sin ang))))
                )
              )
              (list (- (car pt_ins) (* dy (sin ang))) (+ (cadr pt_ins) (* dy (cos ang))))
            )
            3
          )
          (setq count (1+ count))
          (if (< count nb_column)
            (setq pt_ins (list (+ (car pt_ins) (* dx (cos ang))) (+ (cadr pt_ins) (* dx (sin ang)))))
            (setq pt_ins (list (- (car pt_row) (* dy (sin ang))) (+ (cadr pt_row) (* dy (cos ang)))) pt_row pt_ins count 0)
          )
        )
        (setq pt_ins pt_tmp)
      )
      ((or (eq (cadr key) 114) (eq (cadr key) 82))
        (initget 0)
        (setq s_ang
          (getorient pt_ins
            (strcat
              "\nNew angle<"
              (angtos (getvar "SNAPANG"))
              ">: "
            )
          )
        )
        (if (not s_ang) (setq s_ang ang))
        (if (and (> s_ang (/ pi 2)) (<= s_ang (/ (* 3 pi) 2)))
          (setq ang (+ s_ang pi))
          (setq ang s_ang)
        )
        (setvar "SNAPANG" ang)
        (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale" (rtos (* unit_draw format_scale) 2 3) ">: "))
      )
      ((or (eq (cadr key) 109) (eq (cadr key) 77))
        (initget 9)
        (setq pt_ins (getpoint "\nSpecify the bottom left corner: "))
        (setq pt_ins (list (car pt_ins) (cadr pt_ins)) pt_tmp pt_ins)
        (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
      )
      ((eq (cadr key) 43)
        (setq format_scale (cadr (member format_scale l_scale)))
        (if (not format_scale) (setq format_scale (car (setq l_scale (mapcar '(lambda (x) (* x 10.0)) l_scale)))))
        (setq dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale))
        (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
      )
      ((eq (cadr key) 45)
        (setq format_scale (cadr (member format_scale (reverse l_scale))))
        (if (not format_scale) (setq format_scale (last (setq l_scale (mapcar '(lambda (x) (* x 0.1)) l_scale)))))
        (setq dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale))
        (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
      )
    )
  )
  (princ "\n")
  (redraw)
  (princ (setq toto (list (list pt_ins (getvar "LASTPOINT")) (getvar "SNAPANG") (* unit_draw format_scale))))
  (command "_.rectang" "_none" (caar toto) "_rotation" (angtos (getvar "SNAPANG")) "_none" (cadar toto))
  (setvar "SNAPANG" old_snapang)
  (prin1)
)
Edited by Tsuky
  • Like 2
Link to comment
Share on other sites
DELLA MAGGIORA YANN Contributor

DELLA MAGGIORA YANN

Posted
Posted

This is great, thanks
The only downside is that we don't control the insertion point, otherwise great work
Do you think you could modify this?
That would be cool

Link to comment
Share on other sites
DELLA MAGGIORA YANN Contributor

DELLA MAGGIORA YANN

Posted
Posted

sorry I didn't see the move function
the letters "R" and "M" are not highlighted that's why

thanks

Link to comment
Share on other sites

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