(defun C:print_to_png_area (/ sk krest-dist max-x max-y min-x min-y point1 point2 temp-y temp-x flag cur-str-temp-x list-coor-krest str-list 1/m file-name
			    list-all-coor-krest list-all-points list-str-for-archaeosys new-list-all-points new-list-points-b-l
			    new-point putch-text-file-coord temp-list ss list-coor-krest-clear pline spisok)
  ;
  (setq sk (getvar "CANNOSCALEVALUE"))
  (setq krest-dist (/ 100.0 sk))
  (initget 1)(setq pline (car (entsel "\nВыбери полилинию: ")))
  (cond
    ((eq pline nil)
     (alert "Ничего не выбрано!"))
    ((not(eq (cdr(assoc 0 (entget pline))) "LWPOLYLINE"))
     (alert "Выбрана не 2D полилиния!"))
    ((eq (cdr(assoc 0 (entget pline))) "LWPOLYLINE")
     (setq spisok (extract_coord_lwpolyline (entget pline)))
     (setq max-x (apply 'max (mapcar 'car spisok)))
     (setq min-x (- (apply 'min (mapcar 'car spisok)) krest-dist))
     (setq max-y (+ (apply 'max (mapcar 'cadr spisok)) krest-dist))
     (setq min-y (apply 'min (mapcar 'cadr spisok)))
     
     (setq temp-y(*(atof(rtos (/ min-y krest-dist) 2 0))krest-dist))
     (if (< temp-y min-y) (setq temp-y (+ temp-y krest-dist)))
     (if (< temp-y max-y)
       (progn
	 (setq temp-x(*(atof(rtos (/ min-x krest-dist) 2 0))krest-dist))
	 (if (< temp-x min-x) (setq temp-x (+ temp-x krest-dist)))
	 (if (< temp-x max-x)
	   (progn
	     (setq str-list (list temp-y))
	     (while (not flag)
	       (setq temp-y (+ temp-y krest-dist))
	       (if (< temp-y max-y) (setq str-list (append str-list (list temp-y))) (setq flag T))
	       )
	     
	     (foreach y str-list
	       (setq cur-str-temp-x temp-x)
	       (setq flag nil)
	       (setq list-coor-krest (append list-coor-krest (list (list cur-str-temp-x y))))
	       (while (not flag)
		 (setq cur-str-temp-x (+ cur-str-temp-x krest-dist))
		 (if (< cur-str-temp-x max-x) (setq list-coor-krest (append list-coor-krest (list(list cur-str-temp-x y)))) (setq flag T))
		 )
	       )
	     (foreach x list-coor-krest
	       (if (or (analisis-point-in-contur spisok x)
		       (analisis-point-in-contur spisok (mapcar '+ x (list krest-dist 0.0 )))
		       (analisis-point-in-contur spisok (mapcar '+ x (list krest-dist (* krest-dist -1.0))))
		       (analisis-point-in-contur spisok (mapcar '+ x (list 0.0 (* krest-dist -1.0)))))
		 (setq list-coor-krest-clear (append list-coor-krest-clear (list x))))
	       )
	     (setq list-coor-krest list-coor-krest-clear)
	     

		(foreach x list-coor-krest
		  (if (not(member x list-all-coor-krest))
		      (setq list-all-points (append list-all-points (list x)))
		      )
		  (foreach y (list (list 0.0 (* krest-dist -1.0))(list krest-dist 0.0 )(list krest-dist (* krest-dist -1.0)))
		    (setq new-point (mapcar '+ x y))
		    (if (not(member new-point list-all-coor-krest))
		      (setq list-all-points (append list-all-points (list new-point)))
		      )
		    )
		  )
		(foreach x list-all-points
		  (setq list-str-for-archaeoSYS (append list-str-for-archaeoSYS (list (strcat
											(rtos (nth 1 x)2 3)"-"(rtos (nth 0 x)2 3)
											";"
											(rtos (nth 1 x)2 3)
											";"
											(rtos (nth 0 x)2 3)))))
		  )
		(setq putch-text-file-coord (strcat
		    (getvar "DWGPREFIX")
		    (substr (getvar "DWGNAME") 1 (-(strlen (getvar "DWGNAME"))4))
		    ".txt"
		    ))
		(alert (strcat"Сейчас будет сформирован файл координат:\n" putch-text-file-coord))
		(file_write_list_to_file putch-text-file-coord list-str-for-archaeoSYS)
		(alert "Файл с координатами сформирован!\nНажать ОК когда будет готов вычисленный файл координат.")
		(if (file_check putch-text-file-coord)
		  (progn
		    (setq new-list-all-points (file_read_to_list putch-text-file-coord))
		    (foreach x new-list-all-points
		      (setq temp-list (convert-string-to-list-be-delimiter x ";"))
		      (setq new-list-points-b-l (append new-list-points-b-l(list (list (nth 0 temp-list)
										       (atof(vl-string-subst "." ","(substr(nth(1-(length temp-list))temp-list)1 12)))
										       (atof(vl-string-subst "." ","(substr(nth(-(length temp-list)2)temp-list)1 12)))
										       ))))
		      )
		    )
		  )

		(foreach x list-coor-krest
		  (setq file-name (strcat (rtos(nth 1 x)2 3) "-" (rtos(nth 0 x)2 3)))
		  (print_to_png x krest-dist (strcat "c:\\work\\" file-name ".png"))
		  )
		
		(foreach x list-coor-krest
		  (setq file-name (strcat (rtos(nth 1 x)2 3) "-" (rtos(nth 0 x)2 3)))
		  (create-map-file file-name x krest-dist new-list-points-b-l 1000)
		  )
	     
		)
	      )
	    )
	  (alert "В указаную область не попадает ни одно перекрестье сетки в данном масштабе.")
	  )
	)
      )
  (princ)
  )

(defun create-map-file (file-name point-1 krest-dist new-list-points-b-l face / point-2 point-3 point-4 map-list point-1-bl point-2-bl point-3-bl point-4-bl)
  (setq point-2 (mapcar '+ point-1 (list krest-dist 0.0 )))
  (setq point-3 (mapcar '+ point-1 (list krest-dist (* krest-dist -1.0))))
  (setq point-4 (mapcar '+ point-1 (list 0.0 (* krest-dist -1.0))))
  (setq point-1-bl(assoc (strcat (rtos(nth 1 point-1)2 3) "-" (rtos(nth 0 point-1)2 3)) new-list-points-b-l))
  (setq point-2-bl(assoc (strcat (rtos(nth 1 point-2)2 3) "-" (rtos(nth 0 point-2)2 3)) new-list-points-b-l))
  (setq point-3-bl(assoc (strcat (rtos(nth 1 point-3)2 3) "-" (rtos(nth 0 point-3)2 3)) new-list-points-b-l))
  (setq point-4-bl(assoc (strcat (rtos(nth 1 point-4)2 3) "-" (rtos(nth 0 point-4)2 3)) new-list-points-b-l))
  (setq map-list(create-map-list file-name
		  (nth 1 point-1-bl)(nth 2 point-1-bl)
		  (nth 1 point-2-bl)(nth 2 point-2-bl)
		  (nth 1 point-3-bl)(nth 2 point-3-bl)
		  (nth 1 point-4-bl)(nth 2 point-4-bl)
		  (/ krest-dist face) (itoa face)))
  (file_write_list_to_file (strcat "c:\\work\\" file-name ".map") map-list)
  )


  
(defun create-map-list (file-name b1 l1 b2 l2 b3 l3 b4 l4 scale face)
  (list
    "OziExplorer Map Data File Version 2.2"
    (strcat file-name".png")
    (strcat file-name".png")
    "1 ,Map Code,"
    "WGS 84,,   0.0000,   0.0000,WGS 84"
    "Reserved 1"
    "Reserved 2"
    "Magnetic Variation,,,E"
    "Map Projection,Mercator,PolyCal,No,AutoCalOnly,No,BSBUseWPX,No"
    (strcat"Point01,xy,    0, 0,in, deg, "(convert-dec-to-dd_mm-print_to_png_area l1)",N, "(convert-dec-to-dd_mm-print_to_png_area b1)",E, grid,   ,           ,           ,N")
    (strcat"Point02,xy,    "face", 0,in, deg, "(convert-dec-to-dd_mm-print_to_png_area l2)",N, "(convert-dec-to-dd_mm-print_to_png_area b2)",E, grid,   ,           ,           ,N")
    (strcat"Point03,xy,    "face", "face",in, deg, "(convert-dec-to-dd_mm-print_to_png_area l3)",N, "(convert-dec-to-dd_mm-print_to_png_area b3)",E, grid,   ,           ,           ,N")
    (strcat"Point04,xy,    0, "face",in, deg, "(convert-dec-to-dd_mm-print_to_png_area l4)",N, "(convert-dec-to-dd_mm-print_to_png_area b4)",E, grid,   ,           ,           ,N")
    "Point05,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point06,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point07,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point08,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point09,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point10,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point11,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point12,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point13,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point14,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point15,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point16,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point17,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point18,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point19,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point20,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point21,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point22,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point23,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point24,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point25,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point26,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point27,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point28,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point29,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Point30,xy,     ,     ,in, deg,    ,        ,N,    ,        ,W, grid,   ,           ,           ,N"
    "Projection Setup,,,,,,,,,,"
    "Map Feature = MF ; Map Comment = MC     These follow if they exist"
    "Track File = TF      These follow if they exist"
    "Moving Map Parameters = MM?    These follow if they exist"
    "MM0,Yes"
    "MMPNUM,4"
    "MMPXY,1,0,0"
    (strcat"MMPXY,2,"face",0")
    (strcat"MMPXY,3,"face","face)
    (strcat"MMPXY,4,0,"face)
    (strcat"MMPLL,1, "(rtos l1 2 6)", "(rtos b1 2 6))
    (strcat"MMPLL,2, "(rtos l2 2 6)", "(rtos b2 2 6))
    (strcat"MMPLL,3, "(rtos l3 2 6)", "(rtos b3 2 6))
    (strcat"MMPLL,4, "(rtos l4 2 6)", "(rtos b4 2 6))
    (strcat"MM1B,"(rtos scale 2 6))
    "MOP,Map Open Position,0,0"
    (strcat"IWH,Map Image Width/Height,"face","face)
    )
  )

;
;;;(atof(vl-string-subst "." ","(substr"46,050224456°"1 12)))
(defun convert-dec-to-dd_mm-print_to_png_area (g-dec / dec-int dec-min)
  (setq dec-int (fix g-dec))
  (setq dec-min (* 60(- g-dec dec-int)))
  (strcat (itoa dec-int) ", " (rtos dec-min 2 4))
  )

;;;(defun C:auto_print_to_png (/ point)
;;;  (setq point (list 2226850.000 505250.000 0.000))
;;;  (print_to_png point 50 (strcat "D:\\" (rtos(nth 1 point)2 3) "-" (rtos(nth 0 point)2 3) ".png"))
;;;;;;  (command "-ПЕЧАТЬ" ;команда печать в текстовом диалоге
;;;;;;	   "Да";Выполнить детальное задание конфигурации? [Да/Нет] <Нет>:
;;;;;;	   "Модель";Имя листа или [?] <Модель>:
;;;;;;	   "PublishToWeb PNG.pc3";Имя устройства вывода или [?] <DWG To PDF.pc3>:
;;;;;;	   "1000x1000";Формат листа бумаги или [?] <1000x1000>:
;;;;;;	   "Книжная";Ориентация чертежа [Книжная/Альбомная] <Альбомная>:
;;;;;;	   "Нет";Перевернуть чертеж? [Да/Нет] <Нет>:
;;;;;;	   "Рамка";Печатаемая область [Экран/Границы/Лимиты/Вид/Рамка] <Рамка>:
;;;;;;	   "2226850,505200";Левый нижний угол рамки <2225593.694350,503952.148749>:
;;;;;;	   "2226900,505250";Правый верхний угол рамки <2228454.224078,506330.286800>:
;;;;;;	   "Вписать";Масштаб печати (пиксел чертежа=Единицы чертежа) или [Вписать] <Вписать>:
;;;;;;	   "Центрировать";Смещение от начала (x,y) или [Центрировать] <Центрировать>:
;;;;;;	   "Да";Учитывать стили печати? [Да/Нет] <Да>:
;;;;;;	   "";Имя таблицы стилей печати или [?] (. если нет) <>:
;;;;;;	   "Да";Учитывать веса линий? [Да/Нет] <Да>:
;;;;;;	   "Обычный";Режим вывода тонированных ВЭ [Обычный/Каркас из предыдущих версий/Скрытие линий из предыдущих версий/Визуальные стили/с  вИзуализацией] <Как на экране>:
;;;;;;	   "D:\\test.png"
;;;;;;	   "Да";Сохранить изменения параметров листа [Да/Нет]? <Н>
;;;;;;	   "Да";Перейти к печати [Да/Нет] <Д>:
;;;;;;	   )
;;;  (princ)
;;;  )

;;;(defun print_png_by_point (point /)
;;;  ;(print_png_by_point'(2227450.000 504150.000 0.0))
;;;  (print_to_png point (/ 100.0 (getvar "CANNOSCALEVALUE")) (strcat "D:\\" (rtos(nth 1 point)2 3) "-" (rtos(nth 0 point)2 3) ".png"))
;;;  )

(defun print_to_png (up-left-point dist file / dn-point up-point)
  
  (setq LN-point (strcat(rtos(nth 0 up-left-point)2 3)","(rtos(-(nth 1 up-left-point)dist)2 3)))
  (setq PV-point (strcat(rtos(+(nth 0 up-left-point)dist)2 3)","(rtos(nth 1 up-left-point)2 3)))
  (draw_osnap_off)
  (setvar "CMDECHO" 0)
  (setvar "NOMUTT" 1)
  (command "-ПЕЧАТЬ" ;команда печать в текстовом диалоге
	   "Да";Выполнить детальное задание конфигурации? [Да/Нет] <Нет>:
	   "Модель";Имя листа или [?] <Модель>:
	   "PublishToWeb PNG.pc3";Имя устройства вывода или [?] <DWG To PDF.pc3>:
	   "1000x1000";Формат листа бумаги или [?] <1000x1000>:
	   "Книжная";Ориентация чертежа [Книжная/Альбомная] <Альбомная>:
	   "Нет";Перевернуть чертеж? [Да/Нет] <Нет>:
	   "Рамка";Печатаемая область [Экран/Границы/Лимиты/Вид/Рамка] <Рамка>:
	   LN-point;"2226850,505200";Левый нижний угол рамки <2225593.694350,503952.148749>:
	   PV-point;"2226900,505250";Правый верхний угол рамки <2228454.224078,506330.286800>:
	   "Вписать";Масштаб печати (пиксел чертежа=Единицы чертежа) или [Вписать] <Вписать>:
	   "Центрировать";Смещение от начала (x,y) или [Центрировать] <Центрировать>:
	   "Да";Учитывать стили печати? [Да/Нет] <Да>:
	   "";Имя таблицы стилей печати или [?] (. если нет) <>:
	   "Да";Учитывать веса линий? [Да/Нет] <Да>:
	   "Обычный";Режим вывода тонированных ВЭ [Обычный/Каркас из предыдущих версий/Скрытие линий из предыдущих версий/Визуальные стили/с  вИзуализацией] <Как на экране>:
	   file;"D:\\test.png"
	   "Нет";Сохранить изменения параметров листа [Да/Нет]? <Н>
	   "Да";Перейти к печати [Да/Нет] <Д>:
	   )
  (setvar "NOMUTT" 0)
  (setvar "CMDECHO" 1)
  (draw_osnap_on)
  )