[julija_b]

Я смотрю, не одна autolisp не пониаю..
Наш шизик препод задал написать программу.. Чертить то я умею, но как писать на autolisp ну ни как не доходит;( Я надеюсь, ктонибудь откликнется в этом форуме, если конечно не сложно..
Моя кошмарная программа:

Написать программу, которая при выборе линий, превратила бы все линии данного слоя в вертикальные.
:cry:

[Admin]

а ваш шизик препод сюда не заходит? 8)

[Kryaker]

- Маловероятно.

[{Smirnoff}]

Программа ужасная :!: :!: :!: [sm1505]

Препод шизик [sm3109]

Между прочим задание то как раз самое простое. Так что скажите своему преподу спасибо. Это он наверное чтобы вы его шизиком не называли вам такое простое задание дал.

Код:

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

(defun c:lver(/ sLine lLay lnSet i curLn lDxf pt1 lLen newPt)
  (if
    (setq sLine(ssget "_:S" '((0 . "LINE"))))
    (progn
      (setq lLay(cdr(assoc 8(entget(ssname sLine 0))))
	    lnSet(ssget "_X" (list '(0 . "LINE")(cons 8 lLay)))
	    i 0
	    ); end setq
      (repeat(sslength lnSet)
	(setq curLn(ssname lnSet i)
	      lDxf(entget curLn)
	      pt1(cdr(assoc 10 lDxf))
	      lLen(distance pt1(cdr(assoc 11 lDxf)))
	      newPt(list(car pt1)(+ lLen(cadr pt1))(nth 2 pt1))
	      ); end setq
	(entmod(subst(cons 11 newPt)(assoc 11 lDxf)lDxf))
	(setq i(1+ i))
	); end repeat
      ); end progn
    (princ "\n*** No line selected ***")
    ); end if
  (princ)
  ); end of c:lver

[julija_b]

:))
ммммммммм ;********* Fantomas, СПАСИБ! ;@

ps. может и не шизик.. ;)

[Operkot]

To julija_b!
А если не секрет вы в каком заведении под каким названием учитесь?
:wink:

[str02]

обозначился преподаватель уважаемой >julija_b

[wjea]

Fantomas!
Бог с ней, прогою твоею, с найденым преподом --добрым шизиком!
Послание то какое, благодарственное, расшифровать ба!

[Геннадий aka PG]

Сообщение от julija_b ) ммммммммм ;********* Fantomas, СПАСИБ! ;@

Ну, в начале то понятно (муси-пуси ...), а вот концовку не понял?
[sm113]

[Vortex_tpr]

По типу страстного поцелуя я так думаю!

[{Smirnoff}]

Ну спасибо, расшифровали

[str02]

>Fantomas смотри, привезут тебе потом маоенького фантомасика и не отверишься

[julija_b]

Только отвернулась, а тут уже фантомасики пошли..:))
Я чего пишу то.. Надо подружку спасать!;) Нагло конечно, но может быть ктонибудь имеет подобную програмульку или готов спасти Ленку..;)
Всё от того же препода.. Может теперь он шизик? ;))
"Написать программу, которая в выбранном пользователем треугольнике указала бы точкой центр вписанной в него окружности, а также нашла бы радиус этой окружности."

[{Smirnoff}]

Написать программу, которая в выбранном пользователем треугольнике указала бы точкой центр вписанной в него окружности, а также нашла бы радиус этой окружности

Ну ведь детская же школьная математика. И что значит " в выбранном пользователем треугольнике"? Треугольник начерчен линиями, или надо просто три раз тыкнутся мышкой?

И вобще огласите весь список...

(mapcar ' [sm311] (Юля Лена Катя Света ...))

[julija_b]

Треугольник начерчен линиями
Ленка последняя!) Вот от неё :*

[{Smirnoff}]

Девчёнки, я чуть позже смогу. Вероятно завтра или послезавтра. Сейчас к сожалению совсем нет времени.

[{Smirnoff}]

Код:

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

(defun c:demo(/ A ANA ANB ANC B BI1AN BI2AN C
	      CCEN LSET ORDLST P PT1 PT2 PT3 PTA
	      PTB R S VERLST)
  (setvar "cmdecho" 0)
  (if
     (and
    (setq lSet(ssget '((0 . "LINE"))))
     (= 3(sslength lSet))
     ); end and
    (progn
      (setq ordLst
	     (mapcar 'cdr
	       (vl-remove-if-not
	       '(lambda(x)(member(car x) '(10 11)))
		  (append(entget(ssname lSet 0))
			 (entget(ssname lSet 1))
			 (entget(ssname lSet 2))
			 ); end append
		  ); end vl-remove-if-not
		 ); end mapcar
	    verLst '()
	       ); end setq
      (foreach ord ordLst
	(if(not(member ord verLst))
	  (setq verLst(append verLst(list ord)))
	  ); end if
	); end foreach
      (if
	  (= 3(length verLst))
	(progn
        (setq verLst(vl-sort verLst '(lambda(x1 x2)(<(car x1)(car x2))))
	      pt1(car verLst)
	      pt2(cadr verLst)
	      pt3(nth 2 verLst)
              A(distance pt1 pt2)
	      B(distance pt2 pt3)
	      C(distance pt3 pt1)
	      p(/(+ A B C)2)
	      S(sqrt(* p(- p A)(- p B)(- p C)))
	      r(/ S p)
	      anA(angle pt1 pt2)
	      anB(angle pt1 pt3)
	      anC(angle pt2 pt3)
	      bi1An(- anA(/(- anA anB)2))
	      bi2An(- anC(/(- anC anB)2))
	      ptA(polar pt1 bi1An 10.0)
	      ptB(polar pt3 bi2An 10.0)
	      cCen(inters pt1 ptA pt3 ptB nil)
	      ); end setq
	(command "_.point" cCen)
	(command "_.circle" cCen r)
	(alert(strcat "\nRadius of Inscribed Circle = "(rtos r))) 
	  ); end progn
	); end if
	); end progn
    ); end if
  (setvar "cmdecho" 1)
    (princ)
    ); end of c:demo

[fixo]

Мне каэтца ваш препод молодца:

(defun c:test ()
(setq oldos (getvar "osmode"))

(setq tri (car (entsel))
elist (entget tri)
pt_list (mapcar 'cdr
(vl-remove-if-not
(function (lambda (x) (eq (car x) 10)))
elist
)
)
)

(setvar "osmode" 0)
(setq a1 (angle (car pt_list)(cadr pt_list))
a2 (angle (car pt_list)(caddr pt_list))
a (+ a1 (/ (- a2 a1) 2))
a3 (angle (cadr pt_list)(caddr pt_list))
a4 (angle (cadr pt_list)(car pt_list))
b (- a3 (/ (- a3 a4) 2))
a5 (- (angle (car pt_list)(caddr pt_list))(/ pi 2)))
(setq o1 (polar (car pt_list) a 100000.0)
o2 (polar (cadr pt_list) b 100000.0)
center (inters (car pt_list) o1 (cadr pt_list) o2 nil)
o3 (polar center a5 100000.0)
perp (inters (car pt_list)(caddr pt_list) center o3 nil)
rad (distance perp center))
(command "_.point" center "")
(command "_.circle" center rad)
(setvar "osmode" oldos)
(princ)
)
(c:test)

[{Smirnoff}]

>julia_b

Забыл сказать. Программа работает на треугольниках начерченными именно как вы просили Линиями, но не Полилинией. Первая часть программы собственно говоря распознование треугольника и выделение координат вершин. Вторая как вы видите стандартные тригонометрические формулы.

[Alaspher]

Взял на себя смелость чуть-чуть отредактировать фантомасову демку:

Код:

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

(defun c:demo (/ aper circ cmd)
  (setq cmd  (getvar "cmdecho")
        aper (getvar "aperture")
  )
  (setvar "cmdecho" 0)
  (setvar "aperture" (getvar "pickbox"))
  (if (vl-cmdf "_.circle"
               "_3p"
               "_tan"
               (cadr (entsel "\nПервая сторона: "))
               "_tan"
               (cadr (entsel "\nВторая сторона: "))
               "_tan"
               (cadr (entsel "\nТретья сторона: "))
      )
    (progn (setq circ (entget (entlast)))
           (vl-cmdf "_.point" (cdr (assoc 10 circ)))
           (alert (strcat "\nRadius of Inscribed Circle = " (rtos (cdr (assoc 40 circ)))))
    )
  )
  (setvar "aperture" aper)
  (setvar "cmdecho" cmd)
  (princ)
)

По-моему, так больше похоже на студенческую работу. Хотя - как посмотреть. :wink: