(defun C:draw_scheme_butts ( / $VALUE dist dl_linii dl_otvoda dl_shtriha htext n_styk sel_automatic_label sel_manual_label sel_napr_label
		       dl_linii dl_otvoda dl_shtriha htext list_points sel_automatic_label sel_manual_label sel_napr_label
		       t1 t2 t3 ang str temp zapros pt_array mleader_obj temp str_chisl str_znam flag flag_return 2Dpline dxf)
  ; функция полуавтоматического рисования схемы стыков
(geo_tools-help "draw_scheme_butts")
  (defun options_styki ( / dcl_id step)
    ; функция для диалогового окна настроек схемы стыков
    (setq dcl_id (geo-tools-load-dialog "d_options_styki"))
    (setq step 2)
    (while (>= step 2)
      (if (null (new_dialog "d_options_styki" dcl_id))(exit))
      (set_tile "d_htext" (rtos htext 2 2))
      (set_tile "d_dl_shtriha" (rtos dl_shtriha 2 2))
      (set_tile "d_dl_linii" (rtos dl_linii 2 2))
      (set_tile "d_dl_otvoda" (rtos dl_otvoda 2 2))
      (set_tile "napr_label" (rtos sel_napr_label 2 0))
      (set_tile "automatic_label" (rtos sel_automatic_label 2 0))
      (set_tile "manual_label" (rtos sel_manual_label 2 0))
      (if (eq sel_manual_label 1)
	(mode_tile "napr_label" 1)
	)
      (action_tile "napr_label"
	"(cond
    ((= $value \"0\")
    (setq sel_napr_label 0)
    )
    ((= $value \"1\")
    (setq sel_napr_label 1)
    )
    ((= $value \"2\")
    (setq sel_napr_label 2)
    )
    ((= $value \"3\")
    (setq sel_napr_label 3)
    )
    ((= $value \"4\")
    (setq sel_napr_label 4)
    )
    ((= $value \"5\")
    (setq sel_napr_label 5)
    )
    ((= $value \"6\")
    (setq sel_napr_label 6)
    )
    ((= $value \"7\")
    (setq sel_napr_label 7)
    )
    )"
	)
      (action_tile "manual_label" "(mode_tile \"napr_label\" 1)(setq sel_manual_label 1)(setq sel_automatic_label 0)")
      (action_tile "automatic_label" "(mode_tile \"napr_label\" 0)(setq sel_automatic_label 1)(setq sel_manual_label 0)")
      (action_tile "accept"
	(strcat
	  "(setq htext (atof (get_tile \"d_htext\")))"
	  "(setq dl_shtriha (atof (get_tile \"d_dl_shtriha\")))"
	  "(setq dl_linii (atof (get_tile \"d_dl_linii\")))"
	  "(setq dl_otvoda (atof (get_tile \"d_dl_otvoda\")))"
	  "(done_dialog 1)"
	  );strcat
	);action_tile
      (setq step (start_dialog))
      (if (= step 3)
	(progn
	  (initget 1)(setq dist (getdist "\nЗадай расстояние: "))
	  (initget 1)(setq n_styk (getreal "\nСколько стыков на этой дистанции?: "))
	  (setq dl_linii (/ dist n_styk))
	  )
	)
      );while
    (unload_dialog dcl_id)
    )
  
  
  
  (if (eq htext nil)(setq htext 2.5))
  (if (eq dl_shtriha nil)(setq dl_shtriha 2))
  (if (eq dl_linii nil)(setq dl_linii 20))
  (if (eq dl_otvoda nil)(setq dl_otvoda 4))
  (if (eq sel_napr_label nil)(setq sel_napr_label 7))
  (if (eq sel_automatic_label nil)(setq sel_automatic_label 1))
  (if (eq sel_manual_label nil)(setq sel_manual_label 0))
  (setq sel_automatic_label 1)
  (setq sel_manual_label 0)
  (while (not (eq 'LIST (type t1)))
    (initget"Настройки Продолжить")(setq t1(getpoint "\nУкажи начальную точку [Настройки/Продолжить]:"))
    (cond
      ((eq t1 "Продолжить")
       (initget)(setq t1(getpoint "\nУкажи начальную точку:"))
       (setq flag_return T)
       )
      ((eq t1 "Настройки")
       (options_styki)
       )))
  (initget)(setq t2(getpoint t1 "\nУкажи направление:"))
  (while (/= t2 nil)
    (setq ang (angle t1 t2))
    (if (eq flag_return nil)
      (progn
	(if
	  (eq 2Dpline nil)
	  (progn
	    (entmake(list
		      '(0 . "LWPOLYLINE")
		      '(100 . "AcDbEntity")
		      '(100 . "AcDbPolyline")
		      (cons 90 2)
		      (cons 43 0.0)
		      (cons 70 0)
		      (cons 10 t1)
		      (cons 10 (polar t1 ang dl_otvoda))
		      )
		    )
	    (setq 2Dpline (entlast))
	    )
	  (progn
	    (setq dxf (entget 2Dpline))
	    (setq dxf (subst (cons 90 (1+ (cdr(assoc 90 dxf))))(assoc 90 dxf) dxf))
	    (entmod (append dxf (list (cons 10 (polar t1 ang dl_otvoda)))))
	    (entupd 2Dpline)
	    )
	  )
	(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(6 . "Continuous") '(100 . "AcDbPolyline")
		       '(90 . 2) '(43 . 0)
		       (cons 10 (polar (polar t1 ang dl_otvoda) (+ ang (/ pi 2))1))
		       (cons 10 (polar (polar t1 ang dl_otvoda) (- ang (/ pi 2))1))))
	(setq temp(getstring t "\nВведи длинну отвода <0>: "))
	(if (/= temp "")(setq str temp))
	(if (eq str nil)(setq str "0"))
	(entmake (list '(0 . "TEXT")
		       (cons 10 t1)
		       '(72 . 1) '(73 . 1)
		       (cons 11 (polar t1 ang (/ dl_otvoda 2)))
		       (cons 40 htext)
		       (cons 1 str)
		       (cons 50 (analysis_angle_be_long_distance ang))
		       (cons 7 (getvar "TEXTSTYLE"))))
	(setq t1 (polar t1 ang dl_otvoda))
	(if (eq str_chisl nil)
	  (setq zapros "\nВведи номер шва.клеймо сварщика: ")
	  (setq zapros (strcat "\nВведи номер шва.клеймо сварщика<" str_chisl ">: " )))
	(setq temp(getstring t zapros))
	(if (/= temp "")(setq str_chisl temp))
	(if (eq str_znam nil)
	  (setq zapros "\nВведи дату пр.работ: ")
	  (setq zapros (strcat "\nВведи дату пр.работ<" str_znam ">: " )))
	(setq temp(getstring t zapros))
	(if (/= temp "")(setq str_znam temp))
	(if (eq sel_manual_label 1)
	  (progn(initget 1)(setq t2(getpoint t1 "\nУкажи направление:")))
	  (setq t2 (mapcar '+ t1
			   (cond
			     ((eq sel_napr_label 0)
			      '(0 12))
			     ((eq sel_napr_label 1)
			      '(12 12))
			     ((eq sel_napr_label 2)
			      '(12 0))
			     ((eq sel_napr_label 3)
			      '(12 -12))
			     ((eq sel_napr_label 4)
			      '(0 -12))
			     ((eq sel_napr_label 5)
			      '(-12 -12))
			     ((eq sel_napr_label 6)
			      '(-12 0))
			     ((eq sel_napr_label 7)
			      '(-12 12))
			     ))))
	(setq list_points (list t1 t2))
	(setq pt_array (convert_coords_list_from_safearray_mleader list_points))
	(setq mleader_obj (vla-addmleader model_spece pt_array 0))
	(vla-put-StyleName mleader_obj "Подписи")
	(vla-put-textstring mleader_obj (strcat str_chisl"\\P"str_znam))
	(vla-put-TextHeight mleader_obj htext)
	))
    (setq flag_return nil)
    (setq flag T)
    (while flag
      (if (eq str nil)
	(setq zapros "\nВведи длинну трубы: ")
	(setq zapros (strcat "\nВведи длинну трубы<" str ">(0=конец линии): " ))
	)
      (setq temp(getstring t zapros))
      (if (/= temp "")(setq str temp))
      (if (eq str nil)(setq str "0"))
      (if (/= str "0")
	(progn
	  (if
	    (eq 2Dpline nil)
	    (progn
	      (entmake(list
			'(0 . "LWPOLYLINE")
			'(100 . "AcDbEntity")
			'(100 . "AcDbPolyline")
			(cons 90 2)
			(cons 43 0.0)
			(cons 70 0)
			(cons 10 t1)
			(cons 10 (polar t1 ang dl_linii))
			)
		      )
	      (setq 2Dpline (entlast))
	      )
	    (progn
	      (setq dxf (entget 2Dpline))
	      (setq dxf (subst (cons 90 (1+ (cdr(assoc 90 dxf))))(assoc 90 dxf) dxf))
	      (entmod (append dxf (list (cons 10 (polar t1 ang dl_linii)))))
	      (entupd 2Dpline)
	      )
	    )
	  (entmake (list '(0 . "TEXT")
			 (cons 10 t1)
			 '(72 . 1) '(73 . 1)
			 (cons 11 (polar t1 ang (/ dl_linii 2)))
			 (cons 40 htext)
			 (cons 1 str)
			 (cons 50 (analysis_angle_be_long_distance ang))
			 (cons 7 (getvar "TEXTSTYLE"))))
	  (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(6 . "Continuous") '(100 . "AcDbPolyline")
			 '(90 . 2) '(43 . 0)
			 (cons 10 (polar (polar t1 ang dl_linii) (+ ang (/ pi 2))(/ 1 (getvar "CANNOSCALEVALUE"))))
			 (cons 10 (polar (polar t1 ang dl_linii) (- ang (/ pi 2))(/ 1 (getvar "CANNOSCALEVALUE"))))
			 ))
	  (setq t1 (polar t1 ang dl_linii))
	  (if (eq str_chisl nil)
	    (setq zapros "\nВведи номер шва.клеймо сварщика: ")
	    (setq zapros (strcat "\nВведи номер шва.клеймо сварщика<" str_chisl ">: " ))
	    )
	  (setq temp(getstring t zapros))
	  (if (/= temp "")(setq str_chisl temp))
	  (if (eq str_znam nil)
	    (setq zapros "\nВведи дату пр.работ: ")
	    (setq zapros (strcat "\nВведи дату пр.работ<" str_znam ">: " ))
	    )
	  (setq temp(getstring t zapros))
	  (if (/= temp "")(setq str_znam temp))
	  (if (eq sel_manual_label 1)
	    (progn(initget 1)(setq t2(getpoint t1 "\nУкажи положение выноски:")))
	    (setq t2 (mapcar '+ t1
			     (cond
			       ((eq sel_napr_label 0)
				'(0 12))
			       ((eq sel_napr_label 1)
				'(12 12))
			       ((eq sel_napr_label 2)
				'(12 0))
			       ((eq sel_napr_label 3)
				'(12 -12))
			       ((eq sel_napr_label 4)
				'(0 -12))
			       ((eq sel_napr_label 5)
				'(-12 -12))
			       ((eq sel_napr_label 6)
				'(-12 0))
			       ((eq sel_napr_label 7)
				'(-12 12))
			       ))))
	  (setq list_points (list t1 t2))
	  (setq pt_array (convert_coords_list_from_safearray_mleader list_points))
	  (setq mleader_obj (vla-addmleader model_spece pt_array 0))
	  (vla-put-StyleName mleader_obj "Подписи")
	  (vla-put-textstring mleader_obj (strcat str_chisl"\\P"str_znam))
	  (vla-put-TextHeight mleader_obj htext)
	  )
	(progn
	  (if
	    (eq 2Dpline nil)
	    (progn
	      (entmake(list
			'(0 . "LWPOLYLINE")
			'(100 . "AcDbEntity")
			'(100 . "AcDbPolyline")
			(cons 90 2)
			(cons 43 0.0)
			(cons 70 0)
			(cons 10 t1)
			(cons 10 (polar t1 ang dl_otvoda))
			)
		      )
	      (setq 2Dpline (entlast))
	      )
	    (progn
	      (setq dxf (entget 2Dpline))
	      (setq dxf (subst (cons 90 (1+ (cdr(assoc 90 dxf))))(assoc 90 dxf) dxf))
	      (entmod (append dxf (list (cons 10 (polar t1 ang dl_otvoda)))))
	      (entupd 2Dpline)
	      )
	    )
	  ;;;	  (entmake (list '(0 . "LINE") (append '(10) t1) (append '(11) (polar t1 ang dl_otvoda))))
	  (if (eq str nil)
	    (setq zapros "\nВведи длинну отвода: ")
	    (setq zapros (strcat "\nВведи длинну отвода <" str ">: " ))
	    )
	  (setq temp(getstring t zapros))
	  (if (/= temp "")(setq str temp))
	  (if (eq str nil)(setq str "0"))
	  (entmake (list '(0 . "TEXT")
			 (cons 10 t1)
			 '(72 . 1) '(73 . 1)
			 (cons 11 (polar t1 ang (/ dl_otvoda 2)))
			 (cons 40 htext)
			 (cons 1 str)
			 (cons 50 (analysis_angle_be_long_distance ang))
			 (cons 7 (getvar "TEXTSTYLE"))))
	  (setq flag nil)
	  (setq t1 (polar t1 ang dl_otvoda))
	  )
	)
      )
    (setq str nil)
    (setq t2 nil)
    (while (not (eq 'LIST (type t2)))
      (initget "Настройки")(setq t2(getpoint t1 "\nУкажи направление [Настройки]: "))
      (cond
	((eq t2 "Настройки")
	 (options_styki))
	((eq t2 nil)
	 (exit)
	 )))
    )
  )
