topic Grid Northing & Easting for layout in Visual LISP, AutoLISP and General Customization Forum

Grid Northing & Easting for layout

eccook — Mon, 26 Feb 2024 15:40:10 GMT

I have been messing with this code and got it to where it is almosgt perfect for my needs. One thing I can't figure out is how to have the Northing & Easting to be represented with a comma. For example: "N123,456 E1,234,567". Any assistance would be greatly appreciated.

(defun c:ADDGRIDTICKS ()

(setvar "CMDECHO" 0)

(command "-osnap" "off")

(setq VP1 nil

interval 0

scale 0

)

(while (not (and (= (cdr(assoc 70 VP1)) 1 ) (= (cdr(assoc 0 VP1)) "LWPOLYLINE" )) )

(setq VP1 (entget(car (entsel "\nSelect Rectangle: "))))

)

(while (not (or (= interval 10) (= interval 50) (= interval 100)))

(setq interval (getint "\nEnter Interval: [10/50/100] "))

)

(while (not (or (= scale 50) (= scale 100) (= scale 200) (= scale 500) (= scale 1000) (= scale 1250)))

(setq scale (getint "\nEnter Scale: [50/100/200/500/1000/1250] "))

)

(setq txtH (* 0.04 scale))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun xRound (x)

(setq A (atoi(substr

(rtos x 2 4)

(- (vl-string-search "." (rtos x 2 4)) 2)

2))

x1 (substr

(rtos x 2 4) 1

(- (vl-string-search "." (rtos x 2 4)) 3)

)

x2 (cond

((= interval 10)

(cond

((< A 5)(setq x2 "00"))

((and (>= A 5) (< A 15))(setq x2 "100"))

((and (>= A 15) (< A 25))(setq x2 "200"))

((and (>= A 25) (< A 35))(setq x2 "300"))

((and (>= A 35) (< A 45))(setq x2 "400"))

((and (>= A 45) (< A 55))(setq x2 "500"))

((and (>= A 55) (< A 65))(setq x2 "600"))

((and (>= A 65) (< A 75))(setq x2 "700"))

((and (>= A 75) (< A 85))(setq x2 "800"))

((and (>= A 85) (< A 95))(setq x2 "900"))

((>= A 95)(setq x2 "100"))

))

((= interval 50)

(cond

((< A 25)(setq x2 "00"))

((and (>= A 25) (< A 75))(setq x2 "50"))

((>= A 75)(setq x2 "100"))

))

((= interval 100)

(cond

((< A 50)(setq x2 "00"))

((>= A 50)(setq x2 "100"))

))

)

(if (= x2 "100")

(setq x1 (itoa (+ (atoi x1) 1))

x2 "00")

)

(setq G1x (strcat x1 x2))

(while (<= (atoi G1x) x)

(cond

( (= interval 10) (setq G1x (itoa (+ (atoi G1x) 10))) )

( (= interval 50) (setq G1x (itoa (+ (atoi G1x) 50))) )

( (= interval 100) (setq G1x (itoa (+ (atoi G1x) 100))) )

)

(defun FindN (A B)

(rtos (+

(-(cadr B)(cadr A))

(-(car B)(car A))

)

(- (atoi Ex) (car A)))

(cadr A))

2 4)

)

(defun FindN2 (A B)

(rtos (- (cadr A)

(-(cadr A)(cadr B))

(-(car B)(car A))

)

(- (atoi Ex)(car A)))

)

2 4)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Get Rec Points ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq RC ())

(foreach n VP1

(cond

((= (car n) 10) (setq RC (cons (cdr n) RC)) )

)

(setq RCx (list (car (nth 0 RC))(car (nth 1 RC))(car (nth 2 RC))(car (nth 3 RC))) )

(cond

( (and (<= (nth 0 RCx)(nth 1 RCx)) (<= (nth 0 RCx)(nth 2 RCx))(<= (nth 0 RCx)(nth 3 RCx)))

(setq pt1 (nth 0 RC)) )

( (and (<= (nth 1 RCx)(nth 0 RCx)) (<= (nth 1 RCx)(nth 2 RCx))(<= (nth 1 RCx)(nth 3 RCx)))

(setq pt1 (nth 1 RC)) )

( (and (<= (nth 2 RCx)(nth 1 RCx)) (<= (nth 2 RCx)(nth 0 RCx))(<= (nth 2 RCx)(nth 3 RCx)))

(setq pt1 (nth 2 RC)) )

( (and (<= (nth 3 RCx)(nth 1 RCx)) (<= (nth 3 RCx)(nth 2 RCx))(<= (nth 3 RCx)(nth 0 RCx)))

(setq pt1 (nth 3 RC)) )

)

(foreach n RC

(cond

((and (= (car n) (car pt1))(> (cadr n) (cadr pt1)))

(setq pt1 n))

)

(setq RC2 ())

(foreach n RC

(cond

((not(= n pt1))(setq RC2(cons n RC2)) )

)

(cond

( (and (> (cadr(nth 0 RC2))(cadr(nth 1 RC2))) (> (cadr(nth 0 RC2))(cadr(nth 2 RC2))) )

(setq pt2 (nth 0 RC2)) )

( (and (> (cadr(nth 1 RC2))(cadr(nth 0 RC2))) (> (cadr(nth 1 RC2))(cadr(nth 2 RC2))) )

(setq pt2 (nth 1 RC2)) )

( (and (> (cadr(nth 2 RC2))(cadr(nth 1 RC2))) (> (cadr(nth 2 RC2))(cadr(nth 0 RC2))) )

(setq pt2 (nth 2 RC2)) )

)

(setq RC3 ())

(foreach n RC2

(cond

((not(= n pt2))(setq RC3(cons n RC3)) )

)

(if

(> (caar RC3)(caar(cdr RC3)))

(setq pt3 (car RC3)

pt4 (nth 1 RC3))

(setq pt3 (nth 1 RC3)

pt4 (car RC3))

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Eastings and Grid Ticks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(command "-LAYER" "M" "Survey Grid" "C" "5" "" "")

(command "-STYLE" "Survey Grid" "arial" "0.0" "1.0" "0.0" "N" "N" "N")

(setq Ex (xRound (car pt1)))

(while (< (atof Ex) (car pt2))

(setq

Ey (FindN pt1 pt2)

Ey2 (if (> (atoi Ex) (car pt4))

(FindN pt4 pt3)

(FindN2 pt1 pt4)

)

StPt (strcat Ex "," Ey)

EndPt (strcat Ex "," Ey2)

)

(command "LINE" StPt (strcat Ex "," (rtos (-(atof Ey) (* scale 0.4)) 2 4)) "")

(setq gline (entget (ssname (ssget "L") 0))

txt1 (strcat (rtos (+ (* 0.0001 scale) (cadr (assoc 10 gline))) 2 4) "," (rtos (caddr (assoc 10 gline)) 2 4))

txt2 (strcat (rtos (+ (* 0.0001 scale) (cadr (assoc 11 gline))) 2 4) "," (rtos (caddr (assoc 11 gline)) 2 4))

txt (strcat "E" (rtos (cadr(assoc 10 gline)) 2 0) )

)

(command "-mtext" txt1 "S" "Survey Grid" "H" txtH "R" txt2 "J" "BR" txt2 txt "")

(command "LINE" (strcat Ex "," (rtos (+(atof Ey2) (* scale 0.4)) 2 4)) EndPt "")

(setq gline (entget (ssname (ssget "L") 0))

txt1 (strcat (rtos (+ (* 0.0001 scale) (cadr (assoc 10 gline))) 2 4) "," (rtos (caddr (assoc 10 gline)) 2 4))

txt2 (strcat (rtos (+ (* 0.0001 scale) (cadr (assoc 11 gline))) 2 4) "," (rtos (caddr (assoc 11 gline)) 2 4))

txt (strcat "E" (rtos (cadr(assoc 10 gline)) 2 0) )

)

(command "-mtext" txt1 "S" "Survey Grid" "H" txtH "R" txt2 "J" "BL" txt2 txt "")

(setq GTy (atoi (xRound (atof Ey2)) ))

(while (< GTy (atof Ey))

(setq

a (* scale 0.075)

Lx1 (list (- (atof Ex) a) GTy)

Lx2 (list (+ (atof Ex) a) GTy)

Ly1 (list (atof Ex) (- GTy a))

Ly2 (list (atof Ex) (+ GTy a))

)

(command "LINE" Lx1 Lx2 ""

"LINE" Ly1 Ly2 "")

(setq GTy (+ GTy interval))

)

(setq Ex (rtos (+ (atof Ex) interval) 2 4))

)

(if (not (= (cadr pt1) (cadr pt2)))

(progn

(setq Ex (xRound (car pt2)))

(while (< (atof Ex) (car pt3))

(setq

Ey (FindN2 pt2 pt3)

Ey2 (if (> (atoi Ex) (car pt4))

(FindN pt4 pt3)

(FindN2 pt1 pt4)

)

StPt (strcat Ex "," Ey)

EndPt (strcat Ex "," Ey2)

)

(command "LINE" StPt (strcat Ex "," (rtos (-(atof Ey) (* scale 0.4)) 2 4)) "")

(setq gline (entget (ssname (ssget "L") 0))

txt1 (strcat (rtos (+ (* 0.0001 scale) (cadr (assoc 10 gline))) 2 4) "," (rtos (caddr (assoc 10 gline)) 2 4))

txt2 (strcat (rtos (+ (* 0.0001 scale) (cadr (assoc 11 gline))) 2 4) "," (rtos (caddr (assoc 11 gline)) 2 4))

txt (strcat "E" (rtos (cadr(assoc 10 gline)) 2 0) )

)

(command "-mtext" txt1 "S" "Survey Grid" "H" txtH "R" txt2 "J" "BL" txt2 txt "")

(command "LINE" (strcat Ex "," (rtos (+(atof Ey2) (* scale 0.4)) 2 4)) EndPt "")

(setq gline (entget (ssname (ssget "L") 0))

txt1 (strcat (rtos (+ (* 0.0001 scale) (cadr (assoc 10 gline))) 2 4) "," (rtos (caddr (assoc 10 gline)) 2 4))

txt2 (strcat (rtos (+ (* 0.0001 scale) (cadr (assoc 11 gline))) 2 4) "," (rtos (caddr (assoc 11 gline)) 2 4))

txt (strcat "E" (rtos (cadr(assoc 10 gline)) 2 0) )

)

(command "-mtext" txt1 "S" "Survey Grid" "H" txtH "R" txt2 "J" "BR" txt2 txt "")

(setq GTy (atoi (xRound (atof Ey2)) ))

(while (< GTy (atof Ey))

(setq

a (* scale 0.005)

Lx1 (list (- (atof Ex) a) GTy)

Lx2 (list (+ (atof Ex) a) GTy)

Ly1 (list (atof Ex) (- GTy a))

Ly2 (list (atof Ex) (+ GTy a))

)

(command "LINE" Lx1 Lx2 ""

"LINE" Ly1 Ly2 "")

(setq GTy (+ GTy interval))

)

(setq Ex (rtos (+ (atof Ex) interval) 2 4))

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Northings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun FindE (A B)

(rtos (+

(-(car B)(car A))

(-(cadr B)(cadr A))

)

(- (atoi Ex) (cadr A)))

(car A))

2 4)

)

(defun FindE2 (A B)

(rtos (- (car A)

(-(car A)(car B))

(-(cadr B)(cadr A))

)

(- (atoi Ex)(car A)))

)

2 4)

)

(setq Ex (xRound (cadr pt2)))

(while (> (atof Ex) (cadr pt2))

(setq Ex (rtos (- (atof Ex) interval) 2 4))

)

(while (> (atof Ex) (cadr pt3))

(setq

Ey (FindE pt2 pt3)

Ey2 (if (> (atoi Ex) (cadr pt1))

(FindE pt2 pt1)

(FindE2 pt1 pt4)

)

StPt (strcat Ey "," Ex)

EndPt (strcat Ey2 "," Ex)

)

(command "LINE" StPt (strcat (rtos (-(atof Ey) (* scale 0.4)) 2 4) "," Ex) "")

(setq gline (entget (ssname (ssget "L") 0))

txt1 (strcat (rtos (cadr (assoc 10 gline)) 2 4) "," (rtos (+ (* 0.0001 scale) (caddr (assoc 10 gline))) 2 4))

txt2 (strcat (rtos (cadr (assoc 11 gline)) 2 4) "," (rtos (+ (* 0.0001 scale) (caddr (assoc 11 gline))) 2 4))

txt (strcat "N" (rtos (caddr(assoc 10 gline)) 2 0) )

)

(command "-mtext" txt2 "S" "Survey Grid" "H" txtH "R" txt1 "J" "BL" txt1 txt "")

(command "LINE" EndPt (strcat (rtos (+(atof Ey2) (* scale 0.4)) 2 4) "," Ex) "")

(setq gline (entget (ssname (ssget "L") 0))

txt1 (strcat (rtos (cadr (assoc 10 gline)) 2 4) "," (rtos (+ (* 0.0001 scale) (caddr (assoc 10 gline))) 2 4))

txt2 (strcat (rtos (cadr (assoc 11 gline)) 2 4) "," (rtos (+ (* 0.0001 scale) (caddr (assoc 11 gline))) 2 4))

txt (strcat "N" (rtos (caddr(assoc 10 gline)) 2 0) )

)

(command "-mtext" txt1 "S" "Survey Grid" "H" txtH "R" txt2 "J" "BR" txt2 txt "")

(setq Ex (rtos (- (atof Ex) interval) 2 4))

)

(if (not (= (cadr pt1) (cadr pt2)))

(progn

(setq Ex (xRound (cadr pt3)))

(while (> (atof Ex) (cadr pt3))

(setq Ex (rtos (- (atof Ex) interval) 2 4))

)

(while (> (atof Ex) (cadr pt4))

(setq

Ey (FindE pt3 pt4)

Ey2 (if (> (atoi Ex) (cadr pt1))

(FindE2 pt2 pt1)

(FindE pt1 pt4)

)

StPt (strcat Ey "," Ex)

EndPt (strcat Ey2 "," Ex)

)

(command "LINE" StPt (strcat (rtos (-(atof Ey) (* scale 0.4)) 2 4) "," Ex) "")

(setq gline (entget (ssname (ssget "L") 0))

txt1 (strcat (rtos (cadr (assoc 10 gline)) 2 4) "," (rtos (+ (* 0.0001 scale) (caddr (assoc 10 gline))) 2 4))

txt2 (strcat (rtos (cadr (assoc 11 gline)) 2 4) "," (rtos (+ (* 0.0001 scale) (caddr (assoc 11 gline))) 2 4))

txt (strcat "N" (rtos (caddr(assoc 10 gline)) 2 0) )

)

(command "-mtext" txt2 "S" "Survey Grid" "H" txtH "R" txt1 "J" "BL" txt1 txt "")

(command "LINE" EndPt (strcat (rtos (+(atof Ey2) (* scale 0.4)) 2 4) "," Ex) "")

(setq gline (entget (ssname (ssget "L") 0))

txt1 (strcat (rtos (cadr (assoc 10 gline)) 2 4) "," (rtos (+ (* 0.0001 scale) (caddr (assoc 10 gline))) 2 4))

txt2 (strcat (rtos (cadr (assoc 11 gline)) 2 4) "," (rtos (+ (* 0.0001 scale) (caddr (assoc 11 gline))) 2 4))

txt (strcat "N" (rtos (caddr(assoc 10 gline)) 2 0) )

)

(command "-mtext" txt1 "S" "Survey Grid" "H" txtH "R" txt2 "J" "BR" txt2 txt "")

(setq Ex (rtos (- (atof Ex) interval) 2 4))

)

(command "-osnap" "End,Mid,Cen,Int,Perp,Near")

(setvar "CMDECHO" 1)

(princ)

)

Re: Grid Northing & Easting for layout

Sea-Haven — Fri, 21 Jun 2024 04:15:30 GMT

Just an answer to your want 123,456 a couple of ways, you need to look at the number and split it, if the (strlen str) is greater than 3 so get (strcat "123" "," "456" frac) look at integer part only.

Are you doing like this.

It takes into account that mview is a rotated view.

PM me for more info.

Re: Grid Northing & Easting for layout

CodeDing — Fri, 21 Jun 2024 17:38:18 GMT

@eccook ,

Just to state the obvious and cover our bases here, if you're using Map 3D or Civil 3D, there is a built-in tool for this.

See here:

https://help.autodesk.com/view/MAP/2024/ENU/?guid=GUID-30F7E71E-5E9D-467C-8630-3795A23193EA

Best,

~DD

Re: Grid Northing & Easting for layout

john.uhden — Sat, 22 Jun 2024 23:38:36 GMT

@eccook ,

This little function can help you...

(defun @rtoc (N Prec / Sign Str i j) ;; RealTOComma (setq Prec (max 0 Prec) Sign (if (minusp N) "-" "") Str (rtos (abs N) 2 Prec) i (vl-string-search "." Str) ) (if (not i)(setq i (strlen Str))) (setq j i) (if (zerop (setq i (rem i 3)))(setq i 3)) (while (< i j) (setq Str (strcat (substr Str 1 i) "," (substr Str (1+ i))) i (+ i 4) j (1+ j) ) ) (strcat Sign Str) )

Re: Grid Northing & Easting for layout

ActivistInvestor — Sun, 23 Jun 2024 14:41:24 GMT

@flinandy59 wrote:
For instance, instead of concatenating raw numbers, use (rtos Ex 2 0 ",") to format Ex with two decimal places and a comma separator. Similarly, use (rtos Ey 2 0 ",") for Ey. Apply these modifications wherever you assemble strings involving these coordinates, ensuring consistent formatting throughout your code. This adjustment will ensure that your output displays Northing and Easting values correctly formatted as "N123,456 E1,234,567" according to your requirements.

It seems as if you're feeding questions posted on these discussion groups to ChatGPT or some other LLM, and just pasting their (largely incorrect) responses back into your replies.

The (rtos) function doesn't accept 4 arguments, and doesn't provide a way to format numbers with commas.

Re: Grid Northing & Easting for layout

rolisonfelipe — Sun, 23 Jun 2024 20:39:36 GMT

THIS IS AN EXCELLENT PROGRAMMING FOR VIEWPORT, BUT IT IS NOT A GRID AND A GOOD SCALE

(DEFUN C:MMV () (C:MALHAVIEWPORT))

;////////////////////////////////////////////////////////////////////////////////////////////////////////

(vl-load-com)

(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 convert_str2mil (str2cnv / l_str n l_nw)

(setq l_str (reverse (vl-string->list str2cnv)) n 1)

(while l_str

(if (zerop (rem n 3))

(setq l_nw (cons 32 (cons (car l_str) l_nw)))

(setq l_nw (cons (car l_str) l_nw)))

(setq l_str (cdr l_str) n (1+ n)))

(vl-list->string l_nw))

(defun c:MALHAVIEWPORT ( / 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 dlt pt_ins

format_scale ech htx nw_pl_out hatch lst_pt str ori_txt nw_txt pt_ins)

(setvar "CMDECHO" 0)

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

(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 "")

(command "_.MSPACE")

(setq unit_draw 1000)

(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))

(vla-StartUndoMark AcDoc)

(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" "A-Romans"))

(progn (setq nw_style (vla-add (vla-get-textstyles AcDoc) "A-Romans"))

(mapcar '(lambda (pr val) (vlax-put nw_style pr val))

(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)

(list "ROMANS.SHX" 0.0 0.0 0.8 0.0))))

(if (not (tblsearch "LAYER" "A-Grilla"))

(vlax-put (vla-add (vla-get-layers AcDoc) "A-Grilla") '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)))

(if (not (tblsearch "BLOCK" "A-NORTE"))

(foreach n '( ( (0 . "BLOCK")

(8 . "0")

(2 . "A-NORTE")

(70 . 0)

(8 . "0")

(62 . 0)

(6 . "ByBlock")

(370 . -2)

(10 0.0 0.0 0.0))

( (0 . "LWPOLYLINE")

(100 . "AcDbEntity")

(67 . 0)

(410 . "Model")

(8 . "0")

(62 . 0)

(6 . "ByBlock")

(370 . -2)

(100 . "AcDbPolyline")

(90 . 13)

(70 . 1)

(38 . 0.0)

(39 . 0.0)

(10 0.00625 -0.001)

(40 . 0.0025)

(41 . 0.0025)

(42 . 0.0)

(91 . 0)

(10 0.0045 -0.001)

(40 . 0.00125655)

(41 . 0.00125655)

(42 . 0.0)

(91 . 0)

(10 0.00112828 0.00479937)

(40 . 0.00130141)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 0.0005 0.00713)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 0.0005 0.00125)

(40 . 0.0025)

(41 . 0.0025)

(42 . 0.0)

(91 . 0)

(10 -0.0005 0.00125)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 -0.0005 0.00713)

(40 . 0.0)

(41 . 0.00130141)

(42 . 0.0)

(91 . 0)

(10 -0.00112828 0.00479937)

(40 . 0.00125655)

(41 . 0.00125655)

(42 . 0.0)

(91 . 0)

(10 -0.0045 -0.001)

(40 . 0.0025)

(41 . 0.0025)

(42 . 0.0)

(91 . 0)

(10 -0.00625 -0.001)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 -0.00625 0.00025)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 -1.20856e-013 0.011)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 0.00625 0.00025)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(210 0.0 0.0 1.0))

( (0 . "LWPOLYLINE")

(100 . "AcDbEntity")

(67 . 0)

(410 . "Model")

(8 . "0")

(62 . 0)

(6 . "ByBlock")

(370 . -2)

(100 . "AcDbPolyline")

(90 . 11)

(70 . 1)

(38 . 0.0)

(39 . 0.0)

(10 0.0025 -0.008875)

(40 . 0.00225)

(41 . 0.00225)

(42 . 0.0)

(91 . 0)

(10 0.00125 -0.008875)

(40 . 0.00137185)

(41 . 0.00137185)

(42 . 0.0)

(91 . 0)

(10 -0.000564075 -0.0065167)

(40 . 0.00144903)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 -0.00125 -0.0045)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 -0.00125 -0.008875)

(40 . 0.00225)

(41 . 0.00225)

(42 . 0.0)

(91 . 0)

(10 -0.0025 -0.008875)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 -0.0025 -0.00225)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 -0.00125 -0.00225)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 0.00125 -0.0055)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 0.00125 -0.00225)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(10 0.0025 -0.00225)

(40 . 0.0)

(41 . 0.0)

(42 . 0.0)

(91 . 0)

(210 0.0 0.0 1.0))

( (0 . "ENDBLK")

(8 . "0")

(62 . 0)

(6 . "ByBlock")

(370 . -2))) (entmake n)))

(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 format_scale)

htx (/ ech 500.0))

(vla-put-layer nw_pl "A-Grilla")

(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 "A-Grilla")

(vla-put-color hatch 8)

(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) "E " (convert_str2mil (rtos (car el) 2 0)) (chr 160))

ori_txt (* pi 0.5)

dlt (polar el pi htx)))

((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) "N " (convert_str2mil (rtos (cadr el) 2 0)) (chr 160))

ori_txt 0.0

dlt (polar el (* pi 0.5) htx)))

(T (setq str nil ori_txt nil)))

(cond ((and dlt str ori_txt)

(setq nw_txt (vla-AddMText Space (vlax-3d-point dlt) (* 1.25 htx) str))

(vla-put-layer nw_txt "A-Grilla")

(vla-put-StyleName nw_txt "A-Romans")

(vla-put-AttachmentPoint nw_txt 7)

(vla-put-InsertionPoint nw_txt (vlax-3d-point (vlax-curve-getClosestPointTo nw_pl dlt T)))

(vla-put-Rotation nw_txt ori_txt)

(vla-put-Height nw_txt (* 1.25 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 9)

(vla-put-InsertionPoint nw_txt (vlax-3d-point (vlax-curve-getClosestPointTo nw_pl dlt T)))

(vla-put-TextString nw_txt (strcat str ".")) )))))

(vla-delete nw_pl_out)

(setq pt_ins (polar pt_ins (+ (* pi 0.25) (angle (list (car ob_lst_pt) (cadr ob_lst_pt)) (list (caddr ob_lst_pt) (cadddr ob_lst_pt)))) (* htx 10)))

(setq nw_txt (vla-AddText Space (strcat " Scale 1/" (rtos ech 2 0)) (vlax-3d-point pt_ins) (* 2 htx)))

(vla-put-layer nw_txt "A-Grilla")

(vla-put-StyleName nw_txt "A-Romans")

(vla-put-Alignment nw_txt acAlignmentMiddleLeft)

(vla-put-Rotation nw_txt (angle (list (car ob_lst_pt) (cadr ob_lst_pt)) (list (caddr ob_lst_pt) (cadddr ob_lst_pt))))

(vla-put-TextAlignmentPoint nw_txt (vlax-3d-point pt_ins))

(initget 9)

(setq pt_ins (getpoint "\nGive insertion point of North: "))

(entmakex

(vl-list*

(cons 0 "INSERT")

(cons 100 "AcDbEntity")

(cons 67 0)

(cons 410 "Model")

(cons 8 "GRID")

(cons 100 "AcDbBlockReference")

(cons 2 "A-NORTE")

(cons 10 pt_ins)

(cons 41 ech)

(cons 42 ech)

(cons 43 ech)

(cons 50 0.0)

(cons 70 0)

(cons 71 0)

(cons 44 0.0)

(cons 45 0.0)

(list (cons 210 (list 0.0 0.0 1.0))) ))

(vl-list*

(cons 0 "INSERT")

(cons 100 "AcDbEntity")(cons 210 (list 0.0 0.0 1.0)))

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