[Юрий Долгорукий]

Добрый день!

Подскажите как установить значок, например полуокружность в месте пересечения линий в автокаде 2014. Имею ввиду автоматическую установку значка в местах пересечений, чтобы в ручную рисовать не приходилось.

Всем заранее спасибо за ответы.

[Кулик Алексей aka kpblc]

Вариант 1. Нарисовать руками
Вариант 2. Создать блок и вставить
Вариант 3. Поискать по форуму среди "готовых программ"

[Юрий Долгорукий]

Сообщение от Кулик Алексей aka kpblc Вариант 1. Нарисовать руками Вариант 2. Создать блок и вставить Вариант 3. Поискать по форуму среди "готовых программ"

Хороший ответ) но я имел ввиду автоматическую прорисовку. Внесу изменения в тему.

[Кулик Алексей aka kpblc]

В чистом ACAD штатных средств для этого нет и не было.

[Юрий Долгорукий]

Сообщение от Кулик Алексей aka kpblc В чистом ACAD штатных средств для этого нет и не было.

Может у кого есть написанный скрипт? Прошу поделиться.

[Сергей812]

Сообщение от Юрий Долгорукий но я имел ввиду автоматическую прорисовку. Внесу изменения в тему.

4. Написать надстройку (основанную на событиях/реакторах), которая:
- отслеживает создание очередной полилинии
- проверяет по определенным критериям (например, слою) - подлежит ли она обработке
- ищет пересечения с другими полилиниями с заданными условиями. Если найдено - строит полуокружность и вписывает ее в полилинию.

5. Пользоваться программами, где это уже реализовано, типа Акад Электрикал. Подозреваю, что речь идет о схемах?

[Юрий Долгорукий]

Сообщение от Сергей812 4. Написать надстройку (основанную на событиях/реакторах), которая: - отслеживает создание очередной полилинии - проверяет по определенным критериям (например, слою) - подлежит ли она обработке - ищет пересечения с другими полилиниями с заданными условиями. Если найдено - строит полуокружность и вписывает ее в полилинию. 5. Пользоваться программами, где это уже реализовано, типа Акад Электрикал. Подозреваю, что речь идет о схемах?

Да, все верно - необходимо прорисовывать схемы соединений. Получается много пересечений, отслеживать каждую линию очень неудобно.

Сообщение от Сергей812 4. Написать надстройку (основанную на событиях/реакторах), которая: - отслеживает создание очередной полилинии - проверяет по определенным критериям (например, слою) - подлежит ли она обработке - ищет пересечения с другими полилиниями с заданными условиями. Если найдено - строит полуокружность и вписывает ее в полилинию. 5. Пользоваться программами, где это уже реализовано, типа Акад Электрикал. Подозреваю, что речь идет о схемах?

Да, все верно. Разрабатываю схемы соединений, пересечений очень много.

Да, разрабатываю схемы соединений.

[Nike]

полувручную

Код:

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

 (defun c:jumper (/ *error* A AENT B1 B2 BDIS BENT DOC ENT OV P1 P2 UFLAG VL O W)
 
  (setq bDis 0.5) ;; Arc Radius (Break Distance / 2.0 )
 
  (defun *error* (msg)
    (and uFlag (vla-EndUndoMark doc))
    (and ov  (mapcar (function setvar) vl ov))
    (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                 (princ (strcat "\n** Error: " msg " **"))))
    (princ))
 
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
        vl '("PEDITACCEPT" "CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))
  (setvar "PEDITACCEPT" 1)
 
  (while (and (setq uFlag (not (vla-StartUndoMark doc)))
              (mapcar   (function setvar) (cdr vl) '(0 32))
              (setq p1  (getpoint "\nPick INTERSECTION: "))
              (setq ent (entsel "\nPick LINE TO BREAK: ")))
 
    (setq p2 (osnap (cadr ent) "_nea")
          b1 (polar p1 (setq a (angle p1 p2)) bDis)
          b2 (polar p1 (+ pi a) bDis))
 
    (setvar "OSMODE" 0)
    (command "_.break" b1 b2)
    (setq bEnt (entlast))
    (if (> a (/ pi 2.))
      (command "_.arc" b2 "_E" b1 "_A" 180.)
      (command "_.arc" b1 "_E" b2 "_A" 180.))
    (setq aEnt (entlast))
 
    (if (eq "LWPOLYLINE" (cdr (assoc 0 (entget (setq ent (car ent))))))
      (progn
        (setq w (vla-get-ConstantWidth (setq o (vlax-ename->vla-object ent))))
        (command "_.pedit" "_M" bEnt aEnt ent "" "_J" "" "")
        (vla-put-ConstantWidth (vlax-ename->vla-object (entlast)) w)))
 
    (setq uFlag (vla-EndUndoMark doc)))
 
  (*error* nil)  
  (princ))

Нажмите для просмотра

https://www.youtube.com/watch?v=Ek4vcdVrC1c
----- добавлено через ~12 мин. -----
Ещё вариант

Код:

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

 (defun c:brc (/ obj rad e pt rf pt1 pt2 arc gr mode data)
  (vl-load-com)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 32)
  (setq obj (car (entsel "\nSelect Object to break:")))
  (Setq rf (getpoint "\nPick center point of arc:"))
  (setq rad (getdist "\nEnter Radius value/Pick two points: "))
  (setq	pt (vlax-curve-getClosestPointTo (setq e obj) rf)
	rf (+ (vlax-curve-getdistatPoint e pt) rad)
  )
  (command "_arc" "_non"
	   (setq pt1 (vlax-curve-getPointAtDist e rf))
	   "_e" "_non"
	   (setq pt2 (vlax-curve-getPointAtDist e (- rf (* rad 2))))
	   "_r" rad
  )
  (setq	arc (entlast)
	tr  0
  )
  (prompt "\nMove Mouse up and down to flip")
  (while
    (progn
      (setq gr	 (grread t 15 0)
	    mode (car gr)
	    data (cadr gr)
      )

      (cond ((= 5 mode)
	     (if ((if (zerop tr)  < >  )  pi
		   (angle pt data)
		 )
	       (setq tr	(boole 6 1 tr)
		     ro
			(vlax-invoke
			  (vlax-ename->vla-object arc)
			  'rotate
			  pt pi
			)
	       )
	     )
	     T
	    )
	    ((member mode '(2 3)) nil)
      )
    )
  )
  (command "_break" obj pt1 pt2)
  (setvar 'osmode osm)
  (princ)
)

----- добавлено через ~20 мин. -----
ещё

Код:

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

  (defun c:peres
       (/ o a ap xy1 xy2 l l4 crug crug2 edge2 line1 line2 line6 layer0)
  (vl-load-com)
;;;  (load "_dwgru-conv-ent-to-vla")
  (setq oldsnap (getvar "osmode"))
  (setq oldlayer (getvar "clayer"))
  (setq oldcolor (getvar "cecolor"))
  (setq oldecho (getvar "cmdecho"))
  (setq oldecho (getvar "cmdecho"))
  (setq oldaperture (getvar "aperture"))
  (setq oldedgemode (getvar "edgemode"))
  (setvar "cmdecho" 0)
  (setq mashtabx (getvar "CANNOSCALEVALUE"))
  (while (null l)
    (if	(null vopros)
      (setq vopros "Yes")
    ) ;_ конец if
    (initget "O")
    (princ (strcat "\n СКОБКИ: " vopros))
    (setq l
	   (nentsel
	     "\n Выберите разрываемую линию вблизи точки пересечения [Option]: "
			      ;Выбор линии
	   ) ;_ конец nentsel
    ) ;_ конец setq
    (if	(eq l "O")
      (progn (initget 1 "Yes No")
	     (setq vopros (getkword "\n Рисовать скобку [Yes/No]: ")
		   l	  nil
	     ) ;_ конец setq
      ) ;_ конец progn
    ) ;_ конец if
  ) ;_ конец while
  (setq xy1 (car (cdr l)))
  (setvar "aperture" 50)
  (setvar "osmode" 2080)
  (setq a (/ 0.5 mashtabx))
  (setvar "clayer" (vla-get-layer (_dwgru-conv-ent-to-vla (car l))))
  (setvar "cecolor"
	  (itoa (vla-get-color (_dwgru-conv-ent-to-vla (car l))))
  ) ;_ конец setvar
  (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"))
  (setvar "EDGEMODE" 1)
  (setq	xy2 (list (- (car xy1) (* mashtabx 0.1))
		  (- (car (cdr xy1)) a)
		  (cadr (cdr xy1))
	    ) ;_ конец list
  ) ;_ конец setq
  (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
  (if (or (eq "LINE" line6) (eq "LWPOLYLINE" line6))
    (princ)
    (progn
      (princ
	"\n ОШИБКА: Выбранный объект не является линией, либо не найдена точка пересечения!"
      ) ;_ конец princ
      (command "_undo" 3)
    ) ;_ конец progn
  ) ;_ конец if
  (setvar "osmode" oldsnap)
  (setvar "cecolor" oldcolor)
  (setvar "cmdecho" oldecho)
  (setvar "osmode" oldsnap)
  (setvar "aperture" oldaperture)
  (setvar "edgemode" oldedgemode)
  (princ)
)

(defun _dwgru-conv-ent-to-vla (ent)
                                 ;|
 *    Выполняет преобразование переданного указателя в vlax-вариант
*    Параметры вызова:
   ent обрабатываемый указатель. Может быть:
     ename
     vla-object
     строка (воспринимается как хендл примитива).
 *    Примеры вызова:
 (setq entity (entmakex (list (cons 0 "POINT") (cons 10 (getpoint)))))
 (_dwgru-conv-ent-to-vla entity) ; #<VLA-OBJECT IAcadPoint 064ad294>
 |;
     (cond
       ((= (type ent) 'vla-object) ent)
       ((= (type ent) 'ename) (vlax-ename->vla-object ent))
       ;|
 ;; Оригинальный вариант:
 ((= (type ent) 'str) (vlax-ename->vla-object (handent ent)))
 |;
       ;; Исправления Alaspher от 28.11.2007. Начало.
       ((= (type ent) 'str)
        (if (setq ent (handent ent))
          (vlax-ename->vla-object ent)
          ) ;_ end of if
        )
       ;; Исправления Alaspher от 28.11.2007. Конец
      (t nil)
       ) ;_ end of cond
     ) ;_ end of defun

[Юрий Долгорукий]

Увидел код, спасибо! Его нужно заводить через командную строку или прописывать где-то в системных файлах?

[Nike]

Как использовать лисп, опубликованный на форуме

[Юрий Долгорукий]

Все запустилось, спасибо!

----- добавлено через 48 сек. -----
Есть вопрос по коду - все работает, но радиус не регулируется. Как это можно сделать?

[Nike]

Юрий Долгорукий, какой код используешь?

[Юрий Долгорукий]

jumper

----- добавлено через 21 сек. -----
В brc можно радиус задать, но неудобно

[Nike]

Юрий Долгорукий,
0.5 в строке
(setq bDis 0.5) ;; Arc Radius (Break Distance / 2.0 )

Если надо ручками задавать - замени на
(setq bDis (getreal "\Радиус: "))

[Юрий Долгорукий]

Все четко)) работает) спасибо))

----- добавлено через 36 сек. -----
Я вообще доволен)) Nike - это круто!)

----- добавлено через ~2 мин. -----
Смотрю команда не работает с полилиниями, есть аналогичный файл?

[Nike]

Сообщение от Юрий Долгорукий Смотрю команда не работает с полилиниями, есть аналогичный файл?

jumper? У меня работает.

[Юрий Долгорукий]

да, увидел!! Спасибо, Nike!!

----- добавлено через ~2 ч. -----
Есть еще вопрос о присвоении свойств огибания самой полилинии, чтобы полностью автоматизировать процесс. Возможно ли это? Может кто делал?

[AMDen]

Доброго Всем Дня!
Подскажите пожалуйста, в лиспе jumper возможно поменять направление дуги в другую сторону?

[Nike]

Сообщение от AMDen в лиспе jumper возможно поменять направление дуги в другую сторону?

Во время выполнения в этой реализации невозможно, а навсегда - в след. строке поменять знак ">" на "<":
(if (> a (/ pi 2.))

[AMDen]

Сообщение от Nike Во время выполнения вы этой реализации невозможно, а навсегда - в след. строке поменять знак ">" на "<": (if (> a (/ pi 2.)

Спасибо! Изменяется. Но как-то странно.
Сейчас речь ведется только о дугах на вертикальных линиях.
При ">" дуги всегда были направлены влево. При "<" направление дуги зависит от выбора линии относительно точки пересечения.

Вообще хотелось бы иметь такой результат: на вертикальных линиях - дуга влево (всегда); на горизонтальных линиях - дуга вверх. Но видимо это должны быть разные алгоритмы в лиспе.