Lisp coordinate grid - from viewport

Lisp coordinate grid - from viewport

Edwin.Saez
Advisor Advisor
17,225 Views
60 Replies
Message 1 of 61

Lisp coordinate grid - from viewport

Edwin.Saez
Advisor
Advisor

hi,

 

someone could help me with some routine to generate a coordinate grid by selecting a "viewport" and that the grid is drawn in the model space.

 

grilla.jpg

Edwin Saez


LinkedIn / AutoCAD Certified Professional


EESignature


 


Si mi respuesta fue una solución para usted, por favor seleccione "Aceptar Solución", para que también sirva a otro usuarios.

0 Likes
Accepted solutions (2)
17,226 Views
60 Replies
Replies (60)
Message 41 of 61

Anonymous
Not applicable

I am a beginner in auto cad. please tell me the the command to use this lisp.

0 Likes
Message 42 of 61

Hannan1
Advocate
Advocate

Command ("ViewPort2Grid").

 

0 Likes
Message 43 of 61

Anonymous
Not applicable

Good Day,

Please help me Lisp coordinate grid - from viewport as below

- E 325 500 to E=325500
- N 8 596 400 to N=8596400

 

Regards,

 

Mujeeb

0 Likes
Message 44 of 61

john.uhden
Mentor
Mentor
Maybe next year.

HAPPY NEW YEAR!

John F. Uhden

0 Likes
Message 45 of 61

Anonymous
Not applicable

Happy New Year...

 

Please help me Lisp coordinate grid - from viewport as below

- E 325 500 to E=325500
- N 8 596 400 to N=8596400

 

Regards,

 

Mujeeb

0 Likes
Message 46 of 61

CADaSchtroumpf
Advisor
Advisor

Happy new year too,

 

For your request find the two lines:

str (strcat (chr 160) "E " (convert_str2mil (rtos (car el) 2 0)) (chr 160))
str (strcat (chr 160) "N " (convert_str2mil (rtos (cadr el) 2 0)) (chr 160))

And change it to:

 

 

str (strcat (chr 160) "E=" (rtos (car el) 2 0) (chr 160))
str (strcat (chr 160) "N=" (rtos (cadr el) 2 0) (chr 160))
0 Likes
Message 47 of 61

symoin
Enthusiast
Enthusiast

Dear CADaSchtroumpf,

Thanks for your valuable code. Could you please help me in the following.

1. I need all the grid interval to be 100m on the model space (irrespective of the scale).

2. I need all the text heights to be 2.5m on the model space (irrespective of the scale).

3. Easting and Northing Values without the spaces as your first post.

4. North Arrow (block) not required.

0 Likes
Message 48 of 61

CADaSchtroumpf
Advisor
Advisor

@symoin 

In this form it is suitable?

 

 

(vl-load-com)
(defun make_field (obj p / nw_obj)
  (setq
    nw_obj
    (vla-addMtext Space
      (vlax-3d-point p)
      0.0
      (strcat
        "{\\fArial|b0|i0|c0|p34;"
        "%<\\AcVar ctab>%"
        " - Scale 1/"
        "%<\\AcExpr (1000/"
        "%<\\AcObjProp Object(%<\\_ObjId "
        (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
        ">%).CustomScale \\f \"%lu2%qf2816\">%"
        ") \\f \"%lu2%pr0\">%"
      )
    )
  )
  (mapcar
    '(lambda (pr val)
      (vlax-put nw_obj pr val)
    )
    (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'BackgroundFill)
    (list 7 3.5 5 p "Standard" "0" 0.0 -1)
  )
)
(defun l-coor2l-pt (lst flag / )
    (if lst
        (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0))
            (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
        )
    )
)
(defun c:ViewPort2Grid ( / js ent dxf_ent pt_v id_vp l h lst_pt js_obj nw_pl unit_draw AcDoc Space UCS save_ucs WSC nw_style f_pat ob_lst_pt pt_ins format_scale ech htx nw_pl_out hatch lst_pt str ori_txt nw_txt pt_ins)
  (setvar "CMDECHO" 0)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space (vla-get-PaperSpace AcDoc)
  )
  (vla-StartUndoMark AcDoc)
  (if (eq (getvar "CTAB") "Model") (setvar "TILEMODE" 0))
  (command "_.PSPACE")
  (princ "\nSelect a viewport: ")
  (while
    (null
      (setq js
        (ssget "_+.:E:S:L"
          (list
            '(0 . "VIEWPORT")
            '(67 . 1)
            (cons 410 (getvar "CTAB"))
            '(-4 . "!=")
            '(69 . 1)
          )
        )
      )
    )
  )
  (setq
    pt_v (cdr (assoc 10 (setq dxf_ent (entget (setq ent (ssname js 0))))))
    id_vp (cdr (assoc 69 dxf_ent))
    l (cdr (assoc 40 dxf_ent))
    h (cdr (assoc 41 dxf_ent))
    lst_pt
    (list
      (list (- (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0)
      (list (+ (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0)
      (list (+ (car pt_v) (* 0.5 l)) (+ (cadr pt_v) (* 0.5 h)) 0.0)
      (list (- (car pt_v) (* 0.5 l)) (+ (cadr pt_v) (* 0.5 h)) 0.0)
    )
    js_obj (ssadd)
  )
  (make_field ent (car lst_pt))
  (entmakex
    (vl-list*
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 67 1)
      (cons 100 "AcDbPolyline")
      (cons 90 (length lst_pt))
      (cons 70 1)
      (mapcar '(lambda (p) (cons 10 p)) lst_pt)
    )
  )
  (ssadd (setq nw_pl (entlast)) js_obj)
  (command "_.MSPACE")
  (setvar "CVPORT" id_vp)
  (command "_.PSPACE")
  (command "_.CHSPACE" js_obj "" (if (> id_vp 2) ""))
  (command "_.MSPACE")
  (setq unit_draw 1000)
  (setq
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    UCS (vla-get-UserCoordinateSystems AcDoc)
    save_ucs
    (vla-add UCS
      (vlax-3d-point '(0.0 0.0 0.0))
      (vlax-3d-point (getvar "UCSXDIR"))
      (vlax-3d-point (getvar "UCSYDIR"))
      "CURRENT_UCS"
    )
  )
  (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG")))
  (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS"))
  (vla-put-activeUCS AcDoc WCS)
  (if (not (tblsearch "STYLE" "$GRID"))
    (progn
      (setq nw_style (vla-add (vla-get-textstyles AcDoc) "$GRID"))
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_style pr val)
        )
        (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
        (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0)
      )
    )
  )
  (if (not (tblsearch "LAYER" "GRID"))
    (vlax-put (vla-add (vla-get-layers AcDoc) "GRID") 'color 7)
  )
  (if (not (findfile "REPQUADISO.pat"))
    (progn
      (setq f_pat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\REPQUADISO.pat") "w"))
      (write-line "*REPQUADISO,Repere du quadrillage lambert" f_pat)
      (write-line "0, 0,0, 0,1" f_pat)
      (write-line "90, 0,0, 0,1" f_pat)
      (close f_pat)
    )
  )
  (setq
    nw_pl (vlax-ename->vla-object nw_pl)
    ob_lst_pt (vlax-get nw_pl 'coordinates)
    pt_ins (list (car ob_lst_pt) (cadr ob_lst_pt))
    format_scale (/ 1.0 (vlax-get (vlax-ename->vla-object ent) 'CustomScale))
    ech (* unit_draw 1.0)
    htx 2.5
  )
  (vla-put-layer nw_pl "GRID")
  (vla-Offset nw_pl (* htx 2.5))
  (setq nw_pl_out (vlax-ename->vla-object (entlast)))
  (setvar "HPORIGINMODE" 0)
  (setvar "HPORIGIN" '(0.0 0.0))
  (setq hatch (vla-AddHatch Space acHatchPatternTypeCustomDefined "REPQUADISO" :vlax-True))
  (vlax-invoke hatch 'AppendOuterLoop (list nw_pl))
  (vla-put-patternscale hatch (/ ech 10.0))
  (vla-put-patternangle hatch 0.0)
  (vla-put-layer hatch "GRID")
  (vla-evaluate hatch)
  (setq lst_pt
    (l-coor2l-pt
      (vlax-invoke
        hatch
        'IntersectWith
        nw_pl
        acExtendThisEntity
      )
      T
    )
  )
  (foreach el lst_pt
    (cond
      ((or (equal (rem (car el) (/ ech 10.0)) (/ ech 10.0) 1E-8) (equal (rem (car el) (/ ech 10.0)) 0.0 1E-8))
        (setq str (strcat (chr 160) (chr 160) "E " (rtos (car el) 2 0) (chr 160) (chr 160) (chr 160) (chr 160)) ori_txt (* pi 0.5))
      )
      ((or (equal (rem (cadr el) (/ ech 10.0)) (/ ech 10.0) 1E-8) (equal (rem (cadr el) (/ ech 10.0)) 0.0 1E-8))
        (setq str (strcat (chr 160) (chr 160) "N " (rtos (cadr el) 2 0) (chr 160) (chr 160) (chr 160) (chr 160)) ori_txt 0.0)
      )
      (T (setq str nil ori_txt nil))
    )
    (cond
      ((and el str ori_txt)
        (setq nw_txt (vla-AddMText Space (vlax-3d-point el) htx str))
        (vla-put-layer nw_txt "GRID")
        (vla-put-StyleName nw_txt "$GRID")
        (vla-put-AttachmentPoint nw_txt 4)
        (vla-put-InsertionPoint nw_txt (vlax-3d-point (polar (vlax-curve-getClosestPointTo nw_pl el T) (+ ori_txt (* 0.25 pi)) (sqrt (* 5.0 htx)))))
        (vla-put-Rotation nw_txt ori_txt)
        (vla-put-Height nw_txt htx)
        (vla-put-Width nw_txt 0.0)
        ;(vla-put-BackgroundFill nw_txt -1)
        (if (> (vlax-safearray-get-u-bound (vlax-variant-value (vla-IntersectWith nw_pl_out nw_txt acExtendNone)) 1) 0)
          (progn
            (vla-put-AttachmentPoint nw_txt 6)
            (vla-put-InsertionPoint nw_txt (vlax-3d-point (polar (vlax-curve-getClosestPointTo nw_pl el T) (+ ori_txt (* 0.75 pi)) (sqrt (* 5.0 htx)))))
          )
        )
      )
    )
  )
  (vla-delete nw_pl_out)
  (and save_ucs (vla-put-activeUCS AcDoc save_ucs))
  (and WCS (vla-delete WCS) (setq WCS nil))
  (command "_.PSPACE")
  (vla-EndUndoMark AcDoc)
  (setvar "CMDECHO" 1)
  (prin1)
)

 

 

 

0 Likes
Message 49 of 61

symoin
Enthusiast
Enthusiast

Dear CADaSchtroumpf,

All thanks to your efforts, this gives most of my requirement.

As a part of the numbers are not visible in viewport. If you can add a margin from the viewport and keep the mtext above the lines without mask....it will be a great help.

Thanks in advance. 

symoin_0-1661428703922.png

 

0 Likes
Message 50 of 61

CADaSchtroumpf
Advisor
Advisor

@symoin 

I have updated the code in post 43  see if can resolve your requirement.

0 Likes
Message 51 of 61

symoin
Enthusiast
Enthusiast

Yes it works as I need, Thanks a lot for solving my issues.

0 Likes
Message 52 of 61

Sea-Haven
Mentor
Mentor

My take on this request.

 

SeaHaven_0-1661481772798.png

 

0 Likes
Message 53 of 61

symoin
Enthusiast
Enthusiast

Thank for all your efforts,

I have my last request for this code,

1. can the text be on a separate layer.

2. Can the margin (gap) be avoided,

3. can this grid be on the viewport in the paper space instead of on model space.

 

thanks in advance.

0 Likes
Message 54 of 61

Sea-Haven
Mentor
Mentor

My grid only works in a layout paperspace.

0 Likes
Message 55 of 61

symoin
Enthusiast
Enthusiast

Dear Mr. Sea Heaven

Many thanks for your code.

I tried your Lisp first its not trimming around the viewport, I re tried this time its selecting more lines during the grid line creation by code itself. and I tried again its giving Fatal error and the drawing file is closed.

Note I used it on AutoCAD 2021, on a new blank file by making a viewport.

 

Kindly look into this

0 Likes
Message 56 of 61

symoin
Enthusiast
Enthusiast
okay noted,
Can my other 2 points requested can de done?
Thanks
0 Likes
Message 57 of 61

CADaSchtroumpf
Advisor
Advisor

@symoin 

Sorry, I don't understand


@symoin  a écrit :

2. Can the margin (gap) be avoided,


 

Message 58 of 61

Sea-Haven
Mentor
Mentor

I never posted code ? Just hinted I may have something went through all the changes when keeping client happy.

0 Likes
Message 59 of 61

sigmmadesigner
Advocate
Advocate

This fantastic section.... I'll try to replicate it in another grid program

 

 

(cond
((and el str ori_txt)
(setq nw_txt (vla-AddMText Space (vlax-3d-point el) htx str))
(vla-put-layer nw_txt "TEXT-GRID")
(vla-put-StyleName nw_txt "$GRID")
(vla-put-AttachmentPoint nw_txt 4)
(vla-put-InsertionPoint nw_txt (vlax-3d-point (polar (vlax-curve-getClosestPointTo nw_pl el T) (+ ori_txt (* 0.25 pi)) (sqrt (* 5.0 htx)))))
(vla-put-Rotation nw_txt ori_txt)
(vla-put-Height nw_txt htx)
(vla-put-Width nw_txt 0.0)
;(vla-put-BackgroundFill nw_txt -1)
(if (> (vlax-safearray-get-u-bound (vlax-variant-value (vla-IntersectWith nw_pl_out nw_txt acExtendNone)) 1) 0)
(progn
(vla-put-AttachmentPoint nw_txt 6)
(vla-put-InsertionPoint nw_txt (vlax-3d-point (polar (vlax-curve-getClosestPointTo nw_pl el T) (+ ori_txt (* 0.75 pi)) (sqrt (* 5.0 htx)))))
)
)
(ssadd (entlast) js_obj)
)
)

0 Likes
Message 60 of 61

symoin
Enthusiast
Enthusiast
Dear CADaSchtroumpf
I want to edit the grid intervals to be 25m and the grid values (text hegiht) to be 1.5 on all the grid lines.
Please tell me which values are to be changed
0 Likes