Jump to content

convert paper space map reference grid lisp to work in model space

aridzv

By aridzv
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

aridzv Community Regular

aridzv

Posted
Posted (edited)

Hi.

I found an amazing lisp to draw map reference grid in paper space.

I need help with change it to work in model space and insand of selecting a viewport in paper space,

select in model space a rectangle (closed polyline) as the map frame, or if it is more simple - to select lower left and upper right corners.

I've attached here both the lisp and a sample drawing showing the resault in paper space.

 

thanks,

aridzv.

 

reference grid.dwg

KoordinatenRand.lsp

Edited by aridzv
Link to comment
Share on other sites
Tsuky Community Regular

Tsuky

Posted
Posted

Hi,

I can offer you this code which draws a grid in model space.

 

The first use may be confusing. Do not hesitate to move the cursor to view the virtual A4 formats assembled at the proposed scale (this is to use a folding machine and be able to place a coherent cover page when folding), and the same for the location and /or rotation if you want finer positioning. The order is validated as soon as you click the top right corner.

  

(vl-load-com)
(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 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:DIM-GRID ( / unit_draw AcDoc Space UCS save_ucs WCS dx_u 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 nw_style f_pat nw_pl ech htx nw_pl_out nw_pl_in hatch_out hatch lst_pt str ori_txt nw_txt)
	(if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
		(setvar "USERS5" (strcat "qz" (itoa (setq unit_draw 1000))))
		(setq unit_draw (atoi (substr (getvar "USERS5") 3)))
	)
	(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)
	(initget 6)
	(setq dx_u (getreal "\nDistance in millimeter of your template iso <210.0>: "))
	(if (not dx_u) (setq dx_u 210.0))
	(setq
		hview (getvar "VIEWSIZE")
		old_snapang (getvar "SNAPANG")
		pt_ins (list (- (car (getvar "VIEWCTR")) (* hview 0.5)) (- (cadr (getvar "VIEWCTR")) (* hview 0.5)))
		dx dx_u dy (* dx_u (sqrt 2)) pt_tmp pt_ins ang (getvar "SNAPANG")
		l_scale '(1.0 1.25 1.5 2.0 2.5 4.0 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 (* dx_u format_scale) dy (* dx_u (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 (* dx_u format_scale) dy (* dx_u (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 up rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change 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 down rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
			)
			((or (eq (cadr key) 112) (eq (cadr key) 80))
				(initget 9)
				(setq pt_ins (getpoint "\nSpecify down left corner: "))
				(setq pt_ins (list (car pt_ins) (cadr pt_ins)) pt_tmp pt_ins)
				(princ (strcat "\nSpecify down rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change 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 (* dx_u format_scale) dy (* dx_u (sqrt 2) format_scale))
				(princ (strcat "\nSpecify down rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change 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 (* dx_u format_scale) dy (* dx_u (sqrt 2) format_scale))
				(princ (strcat "\nSpecify down rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
			)
		)
	)
	(princ "\n")
	(redraw)
	(if (not (tblsearch "STYLE" "$DIM-GRID"))
		(progn
			(setq nw_style (vla-add (vla-get-textstyles AcDoc) "$DIM-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" "DIM-GRID"))
		(vlax-put (vla-add (vla-get-layers AcDoc) "DIM-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-invoke Space 'AddLightWeightPolyline
			(append
				pt_ins
				(polar pt_ins (+ (getvar "SNAPANG") (* pi 0.5)) (* (distance pt_ins (getvar "LASTPOINT")) (sin (- (angle pt_ins (getvar "LASTPOINT")) (getvar "SNAPANG")))))
				
				(list (car (getvar "LASTPOINT")) (cadr (getvar "LASTPOINT")))
				(polar pt_ins (getvar "SNAPANG") (* (distance pt_ins (getvar "LASTPOINT")) (cos (- (angle pt_ins (getvar "LASTPOINT")) (getvar "SNAPANG")))))
			)
		)
		ech (* unit_draw format_scale)
		htx (/ ech 500.0)
	)
	(vla-put-Closed nw_pl 1)
	(vla-put-layer nw_pl "DIM-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 "DIM-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 "DIM-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 "DIM-GRID")
				(vla-put-StyleName nw_txt "$DIM-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) (getvar "SNAPANG")) (* 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 "DIM-GRID")
	(vla-put-StyleName nw_txt "$DIM-GRID")
	(vla-put-Alignment nw_txt acAlignmentMiddleLeft)
	(vla-put-Rotation nw_txt (getvar "SNAPANG"))
	(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)
	(setvar "SNAPANG" old_snapang)
	(prin1)
)

 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Just a comment rather than picking a rectang it would be much better to make a rectang at a desired plot scale  based on a sheet size. The other thing looking at the sample dwg, where I worked the dwg would be rejected there is no way we would produce a grid based on numbers like  763,900 the rectang should use 760,900. same the 319 would be say 320.

 

For the grid in layouts I wrote, I re calc say the left hand lower corner point to be a whole number like 750,850 then would draw the rectang.

Link to comment
Share on other sites
aridzv Community Regular

aridzv

Posted
  • Author
Posted (edited)

@BIGAL

the drawing I shared showed in paper space the needed resault in model space...

 

anyhow,

I've managed to solved it and attached here the code for the referance grid in model space.

at the moment the rectangle used for the frame must be drawn from lower left corner to upper right for the lisp to work proparly.

 

aridzv.

 

 

 

KoordinatenRand_Ms.lsp

Edited by aridzv
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...