Заполнение круга с дыркой линиями
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Заполнение круга с дыркой линиями

Заполнение круга с дыркой линиями

Ответ
Поиск в этой теме
Непрочитано 08.06.2008, 15:19 #1
Заполнение круга с дыркой линиями
coyc
 
Регистрация: 25.12.2005
Сообщений: 3

Нужно нарисовать круг с дыркой (еще одна окружность) и заполнить его линиями, причем дырка не заполняется. У меня получилось только заполнить линиями до дырки.
Код:
[Выделить все]
(defun c:круг()


;ввод данных
   (SETQ P11 (GETPOINT "\nВведите центр круга"))
   (SETQ P12 (GETPOINT P11 "\nВведите точку на окружности"))

;промежуточные вычисления

   (SETQ r1 (distance P11 P12))
   (COMMAND "круг" P11 r1 )

;ввод данных

   (SETQ P21 (GETPOINT "\nВведите центр круга"))
   (SETQ P22 (GETPOINT P21 "\nВведите точку на окружности"))
;промежуточные вычисления

   (SETQ r2 (distance P21 P22))
   (COMMAND "круг" P21 r2 )

   
   (SETQ x10 (CAR P11))
   (SETQ y10 (CAR (CDR P11)))
   
   (SETQ x11 ( - x10 r1))
   (SETQ x23 ( + x10 r1))

   (SETQ x20 (CAR P21))
   (SETQ y20 (CAR (CDR P21)))

   
   (SETQ x21 ( - x20 r2))
   (SETQ x23 ( + x20 r2))
   
   (SETQ dx 1)  

   (SETQ n ( / (* r1 2) dx))
   (SETQ n (fix n))

   (SETQ n1 (/ (- (abs (- x21 x11)) 2) dx))
   (SETQ n1 (fix n1))

   (SETQ n2 (/ (- (* r2 2) 2) dx))
   (SETQ n2 (fix n2))

   (SETQ n3 (/ (abs (- n (+ n1 n2))) dx ))
   (SETQ n3 (fix n3))

   (SETQ a (distance P11 P21))


   (if ( < r1 (+ a r2))
      ("Error")
      
   )


   (repeat n1

      (SETQ x12 (+ x11 dx))
      
         (SETQ y11 (+ y10 (sqrt (- (* r1 r1) (* (- x12 x10) (- x12 x10))  )))   ) 
         (SETQ P13 (LIST x12 y11))

         (SETQ y12 (- y10 (sqrt (- (* r1 r1) (* (- x12 x10) (- x12 x10))  )))   )
         (SETQ P14 (LIST x12 y12))
      
     
         (COMMAND "плиния" P13  P14   )
         (COMMAND)
         (SETQ dx( + dx 1))    
    )
      
   (repeat n2

      (SETQ x22 (+ x21 dx))
      
         (SETQ y11 (+ y10 (sqrt (- (* r1 r1) (* (- x22 x10) (- x22 x10))  )))   ) 
         (SETQ P13 (LIST x22 y11))

         (SETQ y12 (- y10 (sqrt (- (* r1 r1) (* (- x22 x10) (- x22 x20))  )))   )
         (SETQ P14 (LIST x22 y12))
      
         (SETQ y21 (+ y20 (sqrt (- (* r2 r2) (* (- x22 x20) (- x22 x20))  )))   ) 
         (SETQ P23 (LIST x22 y21))

         (SETQ y22 (- y20 (sqrt (- (* r2 r2) (* (- x22 x20) (- x22 x20))  )))   )
         (SETQ P24 (LIST x22 y22))
     
         (COMMAND "плиния" P13  P23   )
         (COMMAND)

         (COMMAND "плиния" P24  P14   )
         (COMMAND)
         (SETQ dx( + dx 1))    
         )
   
   (repeat n3

      (SETQ x13 (+ x23 dx))
      
         (SETQ y11 (+ y10 (sqrt (- (* r1 r1) (* (- x23 x10) (- x13 x10))  )))   ) 
         (SETQ P13 (LIST x13 y11))

         (SETQ y12 (- y10 (sqrt (- (* r1 r1) (* (- x13 x10) (- x13 x10))  )))   )
         (SETQ P14 (LIST x12 y12))
      
     
         (COMMAND "плиния" P13  P14   )
         (COMMAND)
         (SETQ dx( + dx 1))    
    )



)
Зарание благодарен.
Просмотров: 3104
 
Непрочитано 08.06.2008, 20:59
#2
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Вообще-то все это можно просто заполнить
штриховкой, но если есть желание сделать
это именно программно, попробуй:

Код:
[Выделить все]
(defun c:CC(/ )


;ввод данных
   (SETQ P11 (GETPOINT "\nВведите центр большего круга"))
   (SETQ P12 (GETPOINT P11 "\nВведите точку на окружности"))

;промежуточные вычисления

   (SETQ r1 (distance P11 P12))
   (setq pb1 (list (- (car P11) r1)(cadr p11) (caddr p11)))
   (setq pb2 (list (+ (car P11) r1)(cadr p11) (caddr p11)))
   (COMMAND "circle" P11 r1 )
   (setq cr1 (entlast))

;ввод данных

   (SETQ P21 (GETPOINT "\nВведите центр меньшего круга"))
   (SETQ P22 (GETPOINT P21 "\nВведите точку на окружности"))
;промежуточные вычисления

   (SETQ r2 (distance P21 P22))
   (setq pm1 (list (- (car P21) r2)(cadr p21) (caddr p21)))
   (setq pm2 (list (+ (car P21) r2)(cadr p21) (caddr p21)))
   (COMMAND "_.circle" "non" P21 r2 )
   (setq cr2 (entlast))
   (setq c1 (car p11)
	c2 (car p21)
	do (car pb1)
	ds (car pm1)
	de (car pm2)
	dm (car pb2)
	dx (+ (car pb1) 1)
	yo (cadr p11)
	ym (cadr p21)
	d 1.0
	)
   (if (or (> de dm)(< ds do))
     (progn
       (alert "=== Ошибка ввода ===\nВнутренний круг выходит\nза пределы наружного")
       (command "_.erase" cr1 cr2 "")
     (exit))
     )
   (command "_.zoom" "_c" p11 (* r1 2))
   (while (< dx dm)
     (cond ((<= dx ds)
	    (setq x dx
		  y1 (- yo (sqrt (abs (- (expt r1 2) (expt (- (car P11) dx) 2)))))
		  y2 (+ yo (sqrt (abs (- (expt r1 2) (expt (- (car P11) dx) 2)))))
		  p1 (list x y1)
		  p2 (list x y2)
		  )
	    (COMMAND "_.line" "_non" p1 "_non" p2 "" )
     (setq dx (+ dx d)
	   )
	    
)
	   ((and (> dx ds)(< dx de))
	    (setq x dx
		  y1 (- yo (sqrt (abs (- (expt r1 2) (expt (- (car P11) dx) 2)))))
		  y2 (- ym (sqrt (abs (- (expt r2 2) (expt (- (car P21) dx) 2)))))
		  y3 (+ ym (sqrt (abs (- (expt r2 2) (expt (- (car P21) dx) 2)))))
		  y4 (+ yo (sqrt (abs (- (expt r1 2) (expt (- (car P11) dx) 2)))))
		  p1 (list x y1)
		  p2 (list x y2)
		  p3 (list x y3)
		  p4 (list x y4)
		  )
	    (COMMAND "_.line" "_non" p1 "_non" p2 "" )
	    (COMMAND "_.line" "_non" p3 "_non" p4 "" )
     (setq dx (+ dx d)
	   )
	    
)
	   ((and (>= dx de)(< dx dm))
	    (setq x dx
		  y1 (- yo (sqrt (abs (- (expt r1 2) (expt (- (car P11) dx) 2)))))
		  y2 (+ yo (sqrt (abs (- (expt r1 2) (expt (- (car P11) dx) 2)))))
		  p1 (list x y1)
		  p2 (list x y2)
		  )
	    (COMMAND "_.line" "_non" p1 "_non" p2 "" )
     (setq dx (+ dx d)
	   )
	    
)
	   (t nil)
	   )
  )
  (command "_.zoom" "_p")
  )
(C:cc)
~'J'~

Последний раз редактировалось fixo, 08.06.2008 в 21:00. Причина: грамматика
fixo вне форума  
 
Автор темы   Непрочитано 09.06.2008, 18:29
#3
coyc


 
Регистрация: 25.12.2005
Сообщений: 3


Спасибо огромное
Не можешь подсказать как сделать тоже самое только фигуры треугольники
coyc вне форума  
 
Непрочитано 09.06.2008, 19:31
#4
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Цитата:
Сообщение от coyc Посмотреть сообщение
Спасибо огромное
Не можешь подсказать как сделать тоже самое только фигуры треугольники
Нет уж, дружок, ты уж сам тут геомерией занимайся
Я в ней мало чего понимаю

~'J'~
fixo вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Заполнение круга с дыркой линиями