Lisp coordinate grid - from viewport

[Edwin.Saez]

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.

[Edwin.Saez]

Any comments please help me to finish this lisp that I need.
Thank you for your comments and suggestions.

[CADaSchtroumpf · Accepted solution]

Perhaps?

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

[Edwin.Saez]

@CADaSchtroumpf,

The texts are not dating with background?
The texts of the East side at the end come with a (.)
Is the only thing that would fail to solve so that it is ready at last.
I really appreciate your help. 

[CADaSchtroumpf]

The texts are not dating with background?

Uncomment the line:

   ;(vla-put-BackgroundFill nw_txt -1)

The texts of the East side at the end come with a (.)

Is the solution that i have find to force (chr 160) at end of the text, if not put a dot the (chr 160) (space forced) is not taken in consideration and text glue to the line and cannot be read correctly.

If you want test, comment the line:

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

[Edwin.Saez]

@CADaSchtroumpf,

I have 1 question, why does autocad force the text background mask to value 1.50?
Lisp works fine, but could you have a text mask with value 1?
The texts come with 1.50 of text mask, which is the default value of autocad.
Eh regenerated the drawing and always kept with a text mask of 1.50.

I got a lisp that generates the ball but it only works from the model, but the texts do not stick to the extremes. Maybe you can find the solution within the lisp.

[Edwin.Saez]

@CADaSchtroumpf,

I encountered an error while executing the lisp.
When the view is rotated, the grid is not generated and the following error is displayed:

Select a viewport:
Select objects:
Invalid point.
; error: Function cancelled
Set the TARGET viewport active and press ENTER to continue.: Set the TARGET viewport active and press ENTER to continue.: Set the TARGET viewport active and press ENTER to continue.: Set the TARGET viewport active and press ENTER to continue.:
1 object(s) changed from PAPER space to MODEL space.
Objects were scaled by a factor of 0.5 to maintain visual
appearance.

[CADaSchtroumpf · Accepted solution]

---

edwin.saez.jamanca a écrit :

@CADaStroumph,

I encountered an error while executing the lisp.
When the view is rotated, the grid is not generated and the following error is displayed:

Select a viewport:
Select objects:
Invalid point.
; error: Function cancelled
Set the TARGET viewport active and press ENTER to continue.: Set the TARGET viewport active and press ENTER to continue.: Set the TARGET viewport active and press ENTER to continue.: Set the TARGET viewport active and press ENTER to continue.:
1 object(s) changed from PAPER space to MODEL space.
Objects were scaled by a factor of 0.5 to maintain visual
appearance.

---

Try with change (line 69)

(command "_.CHSPACE" js_obj "")

by

(command "_.CHSPACE" js_obj "" (if (> id_vp 2) ""))

[Edwin.Saez]

@CADaSchtroumpf,

Thanks for all the help.
You can not solve the text mask at value 1. it was always defaulted to 1.5.
But in general I can already use the lisp well.
thanks for everything.

[CADaSchtroumpf]

---

edwin.saez.jamanca a écrit :

You can not solve the text mask at value 1. it was always defaulted to 1.5.

---

You can try to add after line 359 a new line with:

 (entmod (subst '(45 . 1) (assoc 45 (entget (entlast))) (entget (entlast))))

[mihai_bantas]

Hello, great job with the code,  can you help me with a problem. I attached a DWG to my request. Thanks

[CADaSchtroumpf]

---

I am surprised at the request !!!
To have the north oriented as presented and to write the N in the sense of the east ...
But if you really want to do this, then invert lines 328 and 335 to have first:

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

and then:

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

[mihai_bantas]

hi, i made the changes ... but i want to change with the value of the point.

As in the example presented  (dwg) with green cloud.

Have a nice day

[CADaSchtroumpf]

Hi,

I not sure to understand, but if you want dim a new grid, you can't move the old grid, you must erase the first and execute the lisp again.

The texte generated is static, no dynamic if you move it, it's false.

[mihai_bantas]

Hy...(i want to work in coordinate system STEREOGRAFIC70, which has the reversed coordinates of the point) i change UCS to XY axe fom YX (acad standard) axe...and it worked. I think it's a UCS problem.

you can temporarily change the ucs on XY until inserting the North block....

[Automohan]

Now is this the updated lisp!!!

(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: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 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 "" (if (> id_vp 2) ""))
	(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 "."))
					)
				)
(entmod (subst '(45 . 1) (assoc 45 (entget (entlast))) (entget (entlast))))
			)
		)
	)
	(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)
)

[Hannan1]

Hi great lisp is it possible to run in all layout tabs without selecting one by one in all tabs if there more layouts it will take more time so is it possible.

[barry2104]

Hi,

I am digging up an old thread as I'm looking for a solution for my Situation which is similar to this Topic.

I am in Need of a Lisp which:

1. generates the Little "+" symbols/lines like shown using the Lisp in Post#2 of this thread. These lines should be inserted into Paperspace rather than Modelspace though
2. Around/outside the selected viewport, I Need the coordinate value as text (either North- or East coordinate values) displayed North/east Rotation. This should go around all edges of the viewport (typically 4 edges, sometimes more though!). These coordinates should also be inserted to paperspace
3. The text in the above Point 2) should have a line/polyline aligning to the North/east and sit just under the text, also inserted to paperspace
4. The length of this line should be 15mm Long, or rather, the viewport should be "Offset" by 15mm and the line should be the required length to go from the viewport-edge to this 15mm Offset line (the Offset line should not be generated/displayed though)
5. Note: the viewports are not necessarily simple rectangles in shape, and on some plans I may want to have multiple viewports, each showing these coordinates along the edge

Attached is an example of what I'm talking about which is done in this case by Hand.

Has some gifted Lisper out there got time to nut this one out for me?

[barry2104]

no one out there with enough smarts to nut out a solution to the request in my post above ^ ?

[mihai_bantas]

Hy, I attach a code found on the net ... maybe it helps.

A good day...

[Anonymous]

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

---

@CADaSchtroumpf wrote:

Hi,

I have making this for meter (initially for French Lambert)

Try it, and adjust it if unit is other.

(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 c:ViewPort2Grid ( / js n pt_v 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 hrtx nw_pl_out nw_pl_in hatch_out hatch lst_pt str ori_txt nw_txtpt_ins)
 (prin1 "\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))))))
 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)
 )
 (vlax-get (vlax-ename->vla-object ent) 'CustomScale)
 (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 "_.CHSPACE" js_obj "")
 (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" "$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 "SIMPLEX.SHX" 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 "QUADISO.pat"))
 (progn
 (setq f_pat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\QUADISO.pat") "w"))
 (write-line "*QUADISO,Quadrillage lambert" f_pat)
 (write-line "0, -.015,0, 0,1, .03,-.97" f_pat)
 (write-line "90, 0,-.015, 0,1, .03,-.97" f_pat)
 (close f_pat)
 )
 )
 (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 format_scale)
 htx (/ ech 500.0)
 )
 (vla-put-layer nw_pl "GRID")
 (vla-Offset nw_pl (* htx 2.5))
 (setq nw_pl_out (vlax-ename->vla-object (entlast)))
 (vla-Offset nw_pl (+ (* htx 2.5) (* htx 10.0)))
 (setq nw_pl_in (vlax-ename->vla-object (entlast)))
 (setvar "HPORIGINMODE" 0)
 (setvar "HPORIGIN" '(0.0 0.0))
 (setq hatch_out (vla-AddHatch Space acHatchPatternTypeCustomDefined "REPQUADISO" :vlax-True))
 (vlax-invoke hatch_out 'AppendOuterLoop (list nw_pl))
 (vlax-invoke hatch_out 'AppendInnerLoop (list nw_pl_out))
 (vla-put-patternscale hatch_out (/ ech 10.0))
 (vla-put-patternangle hatch_out 0.0)
 (vla-put-layer hatch_out "GRID")
 (vla-evaluate hatch_out)
 (setq hatch (vla-AddHatch Space acHatchPatternTypeCustomDefined "QUADISO" :vlax-True))
 (vlax-invoke hatch 'AppendOuterLoop (list nw_pl_in))
 (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_out
 'IntersectWith
 nw_pl_out
 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 " " (rtos (car el) 2 0) " ") 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 " " (rtos (cadr el) 2 0) " ") ori_txt 0.0)
 )
 (T (setq str nil ori_txt nil))
 )
 (cond
 ((and el str ori_txt)
 (setq nw_txt (vla-AddText Space str (vlax-3d-point el) htx))
 (vla-put-layer nw_txt "GRID")
 (vla-put-StyleName nw_txt "$GRID")
 (vla-put-Alignment nw_txt acAlignmentMiddleLeft)
 (vla-put-Rotation nw_txt ori_txt)
 (vla-put-TextAlignmentPoint nw_txt (vlax-3d-point el))
 (if (vlax-invoke nw_pl 'IntersectWith nw_txt acExtendThisEntity)
 (vla-put-Alignment nw_txt acAlignmentMiddleRight)
 )
 )
 )
 )
 (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 "GRID")
 (vla-put-StyleName nw_txt "$GRID")
 (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))
 (and save_ucs (vla-put-activeUCS AcDoc save_ucs))
 (and WCS (vla-delete WCS) (setq WCS nil))
 (vla-EndUndoMark AcDoc)
 (prin1)
)

---