[plaz]

Lisp программисты помогите
Нужена програмка которая в пересечении 2х линий разрывает одну из них и место разрыва соединяет дугой. Хочу использовать при создании технологических схем. Может у кого есть в наработках?
[ATTACH]1082713823.jpg[/ATTACH]

[{Smirnoff}]

Вроде можно доработать одну мою програмку. На выходных если будет время сделаю (если надобность не отпадет раньше). Вопрос, надо ли объединять в полилинию два отрезка и дугу?

[plaz]

Нет, объединять совсем не обязательно

[Apelsinov]

писал давно, но работает

Код:

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

(defun c:peres
       (/ o a ap xy1 xy2 L L4 crug crug2 edge2 line1 line2 line6)
  (setq o (getvar "osmode"))
  (setvar "cmdecho" 0)

  (if (null mashtabx)
    (setq mashtabx (getreal "\n Введите масштаб:"))
  )
  		;Выбор линии
  (while (null L)
    (if	(null vopros)
      (setq vopros "No")
    )
    (initget "O")
    (princ (strcat "\n СКОБКИ: " vopros))
    (setq L
	   (nentsel
	     "\n Выберите разрываемую линию вблизи точки пересечения [Option]: "
	   )
    )
    (if	(eq L "O")
      (progn (initget 1 "Yes No")
	     (setq vopros (getkword "\n Рисовать скобку [Yes/No]: ")
		   L	  nil
	     )
      )
    )
  )
					;Точка центра круга
  (setq xy1 (car (cdr L)))
					; Отрисовка круга
  (setq ap (getvar "aperture"))
  (setvar "aperture" 50)
  (setvar "osmode" 2080)
  (setq a (* 1 mashtabx))
  (command "circle" xy1 a)
					;Уточнение центра круга
  (setq xy1 (getvar "lastpoint"))
  (setq L4 (list (car L) xy1))
					;Расчет разрыва  линии
  (setq line1 (ssget "_l"))
  (command "_trim" line1 "" L4 "")
					;Нахождение  круга
  (setq crug (ssget "_p"))
					;Расчет дуги
  (setq	line2 (ssget "_l")
	edge2 (getvar "EDGEMODE")
  )
  (setvar "EDGEMODE" 1)
  (setq	xy2 (list (- (car xy1) (* mashtabx 0.1))
		  (- (car (cdr xy1)) a)
		  (cadr (cdr xy1))
	    )
  )
  (setq crug3 (list (cadr (car (ssnamex crug))) xy2))
  (setq line6 (cdr (cadr (entget (cadr (car (ssnamex line2)))))))

  (if (eq vopros "No")
    (command "erase" crug "")
    (command "_trim" line2 "" crug3 "")
  )
  (if (eq "LINE" line6)
    (princ)
    (progn
      (princ
	"\n ОШИБКА: Выбранный объект не является линией, либо не найдена точка пересечения!"
      )
      (command "undo" 3)
    )
  )
					;Хвосты
  (setvar "aperture" ap)
  (setvar "osmode" o)
  (setvar "cmdecho" 1)
  (setvar "EDGEMODE" edge2)
  (princ)
)

[Pilot]

2 Apelsinov
Что-то не работает - линию рвет, а полукруг не рисует!

[Apelsinov]

>Pilot
При запуске обратите внимание на [Option]

[Pilot]

Понял. Заработало.

[plaz]

То что доктор прописал.
Спасибо
[sm154]

[Pilot]

Вопрос ко всем, кто уже успел попользоваться представленной Apelsinov-ым прогой: По вашему мнению, каков наиболее часто встречающийся или самый "красивый" размер рисуемой дуги в районе пересечения линий?
Дело в том, что прога оказалась действительно удобной, и я планирую (если уважаемый Автор не возражает) этот Лисп слегка модифицировать, исключив начальный запрос "масштаба" и привязав размер дуги ну, скажем, к высоте текущего текста.

[Apelsinov]

я так думаю, что наиболее удобноым размером будет 2мм (диаметр), заложенные в программе, А масштаб можно автоматически брать из переменной dimscale.

[plaz]

По мне наиболее удобный размер 3мм (радиус), что бы и на насыщенных схемах разрывы были бы видны.
Большой + к твоей программе, если бы отрисовываемая дуга закидывалась на слой разрываемой линии.

[Apelsinov]

>plaz, вот вариант: масштаб задан по dimscale, расстояние 3мм, слой как просили.

Код:

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

(defun c:peres
	       (/ o a ap xy1 xy2 L L4 crug crug2 edge2 line1 line2 line6
		layer0)
  (setq o (getvar "osmode"))
  (setvar "cmdecho" 0)
(setq mashtabx (getvar "dimscale"))
					;Выбор линии
  (while (null L)
    (if	(null vopros)
      (setq vopros "No")
    )
    (initget "O")
    (princ (strcat "\n СКОБКИ: " vopros))
    (setq L
	   (nentsel
	     "\n Выберите разрываемую линию вблизи точки пересечения [Option]: "
	   )
    )
    (if	(eq L "O")
      (progn (initget 1 "Yes No")
	     (setq vopros (getkword "\n Рисовать скобку [Yes/No]: ")
		   L	  nil
	     )
      )
    )
  )
					;Точка центра круга
  (setq xy1 (car (cdr L)))
					; Отрисовка круга
  (setq ap (getvar "aperture"))
  (setvar "aperture" 50)
  (setvar "osmode" 2080)
  (setq a (* 1.5 mashtabx))
  (setq layer0 (getvar "clayer"))
  (setvar "clayer" (cdr (assoc 8 (entget (car L)))))
  (command "circle" xy1 a)
  (setvar "clayer" layer0)
					;Уточнение центра круга
  (setq xy1 (getvar "lastpoint"))
  (setq L4 (list (car L) xy1))
					;Расчет разрыва  линии
  (setq line1 (ssget "_l"))
  (command "_trim" line1 "" L4 "")
					;Нахождение  круга
  (setq crug (ssget "_p"))
					;Расчет дуги
  (setq	line2 (ssget "_l")
	edge2 (getvar "EDGEMODE")
  )
  (setvar "EDGEMODE" 1)
  (setq	xy2 (list (- (car xy1) (* mashtabx 0.1))
		  (- (car (cdr xy1)) a)
		  (cadr (cdr xy1))
	    )
  )
  (setq crug3 (list (cadr (car (ssnamex crug))) xy2))
  (setq line6 (cdr (cadr (entget (cadr (car (ssnamex line2)))))))

  (if (eq vopros "No")
    (command "erase" crug "")
    (command "_trim" line2 "" crug3 "")
  )
  (if (eq "LINE" line6)
    (princ)
    (progn
      (princ
	"\n ОШИБКА: Выбранный объект не является линией, либо не найдена точка пересечения!"
      )
      (command "undo" 2)
    )
  )
					;Хвосты
  (setvar "aperture" ap)
  (setvar "osmode" o)
  (setvar "cmdecho" 1)
  (setvar "EDGEMODE" edge2)
  (princ)
)

[plaz]

:!: :!: :!: YOU ARE THE BEST :!: :!: :!: