Помогите разобраться c программой на AutoLisp

Напалм · 21.11.2011, 21:05

вот моё задание.

Объединение сегментов линий в одну полилинию. В диалоговом окне (dX,dY) устанавливаются значения различия координат конечных точек соседних сегментов будующей полилинии. Кнопкой "Select" выбираются сегменты предполагаемой полилинии, информация о которых отображается в ListBox (номер сегмента, X, Y - координаты начальных и конечных точек сегментов). По нажатию на "OK" сегменты, значения координат которых соответствуеют условию (менее заданных dX, dY), объединяются в единую полилинию.

Код:

[Выделить все]

MY : dialog
{
	label = "Объединение линий";
	: list_box {key="lst";}
	: column {
		: text {}
		: button {label = "Select"; key = "sel"; width = 15; fixed_width = true;  alignment = centered;}
		: text {}
		: row {
			: edit_box { label = "dx"; 
				key = "x1"; 
				fixed_width = true; 
				edit_width = 8; 
				value = "0"; }
			: edit_box {label = "dy"; 
				key = "y1"; 
				fixed_width = true; 
				edit_width = 8; 
				value = "0"; }	
		}
		:text {}
		ok_cancel;
	}
}

Код:

[Выделить все]

 (defun sav()
(setq f (open text "W"))


(if (= (atoi veb_line) 1)
 (  progn
(setq sdel (ssget "X" '((0 . "LINE"))))
(if (/= sdel nil)
( progn
(setq i 0)
(while (< i (sslength sdel))
(setq q (entget (ssname sdel i)))
(setq lin (cdr (assoc 62 q)))
(setq f (open text "A"))
(write-line "" f)
  (princ "Line_" f)
  (princ i f)
  (princ "; " f)
  (princ "color=" f)
  (princ lin f)
  (princ "; " f)
(setq lin (cdr (assoc 10 q)))
  (princ "begin_point=" f)
  (princ lin f)
  (princ "; " f)
(setq lin (cdr (assoc 11 q)))
  (princ "end_point=" f)
  (princ lin f)
  (princ "; " f)
(setq lin (cdr (assoc 8 q))) 
  (princ "Layer_name=" f)
  (princ lin f)
  (princ "; " f)
 (setq lin (cdr (assoc 6 q))) 
  (princ "Type_line=" f)
  (princ lin f)
  (princ "." f)
  
(write-line "" f)  
(close f)  
(setq i(+ i 1))
(setq f (open text "A"))
))
)
 )
 )
 
 
(if (= (atoi veb_polyline) 1)
(  progn
(setq sdell (ssget "X" '((0 . "LWPOLYLINE"))))
(if (/= sdell nil)
( progn
(setq j 0)
(while (< j (sslength sdell)) 
(setq r (entget (ssname sdell j)))
(setq pol (cdr (assoc 62 r)))
(setq f (open text "A"))
(write-line "" f)
  (princ "Polyline_" f)
  (princ j f)
  (princ "; " f)
  (princ "color=" f)
  (princ pol f)
  (princ "; " f)  
(princ "Coordinates=" f)  
(foreach n r (if (= (car n) 10)
                     (progn
		             (setq qxc (cdr n))
			         (princ qxc f)
			         (princ "; " f)
					 )
					 )
			   
)
(setq a 0)

(foreach n r (if (= (car n) 42)
                    (progn
					(setq a (+ a 1))
					(if (/= (cdr n) 0)
					    (progn
						(setq aa a)
						(setq zas (cdr n))
						(setq bubl zas)
						(setq aaa (+ aa 1))
						(setq b 0)
									(foreach n r (if (= (car n) 10)
						(progn
						(setq b (+ b 1))
						(if (= b aa)
						(setq pt1 (cdr n))
						)
						(if (= b aaa)
						(setq pt2 (cdr n))
						)
(if (and (/= bubl nil) (/= bubl 0) )
 (progn
(setq 	dst (distance pt1 pt2)
	rad	(+ (* (/ dst 2.0) bubl) (/ (- (* (/ dst 2.0) (/ dst 2.0))
		(* (/ (* dst bubl) 2.0) (/ (* dst bubl) 2.0))) (* dst bubl)))
	cnt	(polar
		(polar pt1 (angle pt1 pt2) (/ dst 2.0))
		(- (angle pt1 pt2) (/ pi 2.0))
		(- (* (/ dst 2.0) bubl) rad))
)
(setq pt (strcat "\n" "\t" " Radius=" (rtos (abs rad) 2 3) "; " "Centr=(" (rtos (nth 0 cnt) 2 3) " " (rtos (nth 1 cnt) 2 3) "); "))
(princ pt f)
(setq bubl 0)


 )
)
						)
						)
										)
						)
					)
					)
			)
)
;(setq b 0)
; (foreach n r (if (= (car n) 10)
                ; (progn
				  ; (setq b (+ b 1))
				  ; (if (= b aa)
				   ; (setq pt1 (cdr n))
				  ; )
				  ; (if (= b aaa)
				   ; (setq pt2 (cdr n))
				  ; )
				; )
              ; )
; )

; (if (/= bubl 0)
 ; (progn
; (setq 	dst (distance pt1 pt2)
	; rad	(+ (* (/ dst 2.0) bubl) (/ (- (* (/ dst 2.0) (/ dst 2.0))
		; (* (/ (* dst bubl) 2.0) (/ (* dst bubl) 2.0))) (* dst bubl)))
	; cnt	(polar
		; (polar pt1 (angle pt1 pt2) (/ dst 2.0))
		; (- (angle pt1 pt2) (/ pi 2.0))
		; (- (* (/ dst 2.0) bubl) rad))
; )
; (setq pt (strcat "\n" "\t" " Radius=" (rtos rad 2 3) "; " "Centr=(" (rtos (nth 0 cnt) 2 3) " " (rtos (nth 1 cnt) 2 3) "); "))
; (princ pt f)

 ; )
; )
(setq pol (cdr (assoc 8 r))) 
  (princ "Layer_name=" f)
  (princ pol f)
  (princ "; " f)
 (setq pol (cdr (assoc 6 r))) 
  (princ "Type_line=" f)
  (princ pol f)
  (princ "." f)
  
(write-line "" f)  
(close f)  
(setq j(+ j 1))
(setq f (open text "A"))
)
)
)
 )
 )

 
(if (= (atoi veb_spline) 1)
(  progn
(setq sdelll (ssget "X" '((0 . "SPLINE"))))
(if (/= sdelll nil)
( progn
(setq k 0)
(while (< k (sslength sdelll)) 
(setq nabor_spline (entget (ssname sdelll k)))
(setq pol (cdr (assoc 62 nabor_spline)))
(setq f (open text "A"))
(write-line "" f)
  (princ "Spline_" f)
  (princ k f)
  (princ "; " f)
  (princ "color=" f)
  (princ pol f)
  (princ "; " f)
  (princ "Coordinates=" f)
(foreach n nabor_spline  (if (= (car n) 10)
                      (progn
		             (setq qwee (cdr n))
			         (princ qwee f)
			         (princ "; " f)
					   )
					 )			    
)
(setq pol (cdr (assoc 8 nabor_spline))) 
  (princ "Layer_name=" f)
  (princ pol f)
  (princ "; " f)
 (setq pol (cdr (assoc 6 nabor_spline))) 
  (princ "Type_line=" f)
  (princ pol f)
  (princ "." f)
  
(write-line "" f)  
(close f)  
(setq k(+ k 1))
(setq f (open text "A"))
)
 )
 )
 (setq f (open text "A"))
 (close f)
 ))
)







(defun run()
  (if (not (new_dialog "MY" dcl_id)) (exit))

(setq sdel (ssget "X" '((0 . "LINE"))))
   (if (/= sdel nil)
  (setq num_line (itoa (sslength sdel)))
    )
  (setq sdell (ssget "X" '((0 . "LWPOLYLINE"))))
   (if (/= sdell nil) 
  (setq num_polyline (itoa (sslength sdell)))
    )
  (setq sdelll (ssget "X" '((0 . "SPLINE"))))
   (if (/= sdelll nil)
  (setq num_spline (itoa (sslength sdelll)))
    )

(set_tile "num_spline" num_spline )
(set_tile "num_polyline" num_polyline )
(set_tile "num_line" num_line )
(set_tile "text" text )


(action_tile "text" "(setq text $value)")
(action_tile "tg_spline" "(setq veb_spline  $value)" )
(action_tile "tg_polyline" "(setq veb_polyline $value)")
(action_tile "tg_line" "(setq veb_line $value)")
(action_tile "bt_Accept" "(done_dialog 1)")
(action_tile "bt_Cancel" "(setq w_n 0)")

(action_tile "bt_Accept" "(done_dialog 1)")
(action_tile "bt_Cancel" "(setq w_n 0)")

(setq w_n (start_dialog))
  (if (= w_n 1) (sav))
)

(defun c:MY ()
  (setq w_n 2  text "D:\\text.txt" num_polyline "0" num_line "0" num_spline "0" i 0 j 0 k 0 veb_polyline "0" veb_spline "0" veb_line "0") 
  (setq dcl_id (load_dialog "MY.dcl"))
  (while (> w_n 0) (run))
  (unload_dialog dcl_id)
)

какие знчения dx, dy нужно задавать?

людей, которые могут мне это объяснить не существует?

Do$ · 23.11.2011, 08:33

Цитата:

Сообщение от Напалм

Объединение сегментов линий в одну полилинию. В диалоговом окне (dX,dY) устанавливаются значения различия координат конечных точек соседних сегментов будующей полилинии. Кнопкой "Select" выбираются сегменты предполагаемой полилинии, информация о которых отображается в ListBox (номер сегмента, X, Y - координаты начальных и конечных точек сегментов). По нажатию на "OK" сегменты, значения координат которых соответствуеют условию (менее заданных dX, dY), объединяются в единую полилинию.

Лисп код совсем не то делает, он выполняет что-то типа подсчета линий полилиний, сплайнов. И диалог про полилинии не для него.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Помогите в рабочей документации разобраться...	Dison	Прочее. Архитектура и строительство	3	16.11.2011 08:14
Помогите разобраться с ГОСТ Р 21.1101, пункты 5.2.1 и 5.2.2	Red_line	Прочее. Архитектура и строительство	6	25.03.2011 15:20
Вопрос электрикам: помогите разобраться с магнитной катушкой!	Andrej_A_O	Электроснабжение	19	01.11.2010 03:55
ANSYS 10 Помогите разобраться.	Aндрeй	ANSYS	6	12.12.2007 00:03
Помогите разобраться с расчетом сваи	kt133a	Основания и фундаменты	6	19.10.2007 07:43