[phantom_l]

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

Или это очень сложно реализовать ?

[Дима_]

Без примера помочь тебе сложно будет.

[phantom_l]

2.dwgДима, спасибо за ответ.
По просьбе трудящихся выкладываю пример .
Имена действующих лиц:
труба - синий
собственно уголок - желтый
иногда еще встречаются т-образные переходники - розовый.
P.S. Т-образные переходники встречаются реже , а вот уголки постоянно и потом очень утомительно их раставлять, очень хотелось бы , чтобы это делалось автоматически.

[phantom_l]

Файл загружаеться ?

[ShaggyDoc]

А инженерным языком разве нельзя - не таинственные "уголки", а отводы, не "т-образные переходники", а тройники, не "черточки", а условные изображения соединения (которые бывают и сварные - одна "черточка", и фланцевые - две "черточки", и раструбные, и резьбовые)?

[phantom_l]

Можна и инженерным, главное чтобы результат был )) А труба ПХВ, и соединение там клеевое , обозначается одной "черточкой ", ну во всяком случае мы так обозначаем. Если честно , думал , что все понятно будет с первого раза ( ну какие еще могут быть уголки ?) Ну хотя это такое дело, инженерный так инженерный, буду стараться

[fixo]

Выделяй в цикле линии ближе к углам
и будет тебе счастье
(надеюсь слой "труба" во всех чертежах,
а иначе замени в листинге кода на другой)

Код:

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

(defun C:UG (/ ang1 ang2 cp1 cp2 el1 el2 ep1 ep2 ip ln1 ln2 p1 p2 pe1 pe2 ps1 ps2 sp1 sp2)
(while
(setq ln1 (car (entsel "\nSelect first line (or press Enter to Exit):" )))
(setq el1 (entget ln1)
      sp1 (cdr (assoc 10 el1))
      ep1 (cdr (assoc 11 el1))
      ln2 (car (entsel "\nSelect the second line :"))
      el2 (entget ln2)
      sp2 (cdr (assoc 10 el2))
      ep2 (cdr (assoc 11 el2))
      ip  (inters sp1 ep1 sp2 ep2 nil)
      )
(if (equal ip sp1 0.001)
    (setq p1 ep1)
  (setq p1 sp1)
  )
(if (equal ip sp2 0.001)
    (setq p2 ep2)
  (setq p2 sp2)
  )
(setq ang1 (angle ip p1)
      ang2 (angle ip p2)
      )
(setq cp1 (polar ip ang1 266.)
      ps1 (polar cp1 (+ ang1 (/ pi 2)) 170.)
      pe1 (polar cp1 (- ang1 (/ pi 2)) 170.)
      cp2 (polar ip ang2 266.)
      ps2 (polar cp2 (+ ang2 (/ pi 2)) 170.)
      pe2 (polar cp2 (- ang2 (/ pi 2)) 170.)
      )

(entmake
  (list (cons 0 "LINE")
  (cons 100  "AcDbEntity")
  (cons 8  "труба")
  (cons 62  2)
  (cons 48  4.0)
  (cons 100  "AcDbLine")
  (cons 10 ps1)
  (cons 11 pe1)))
(entmake
  (list (cons 0 "LINE")
  (cons 100  "AcDbEntity")
  (cons 8  "труба")
  (cons 62  2)
  (cons 48  4.0)
  (cons 100  "AcDbLine")
  (cons 10 ps2)
  (cons 11 pe2)))
  )
(princ)
)

[phantom_l]

Попробовал, работает. Несколько вопросиков: 1.в цикле это значит просто enter нажимать для повтора команды или как-то по - другому ? 2. По-моему рисует не только в слое "труба" или этот слой просто должен быть?
Но это детали. А вобще очень даже неплохо, я бы даже сказал великолепно !! Спасибо !

[phantom_l]

Единственное , хотел немножко уменьшить размер "черточек ", это здесь меняется : (if (equal ip sp1 0.001) ? Вроде единственное число, прошу меня поправить , если не так )

[Donhuan]

Делает все сама. Сделал все желтым цветом. Если очень надо тройники сиреневые то могу доделать.

Код:

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

;;;Igor Kireev (Donhuan) 06.2008. Для dwg.ru.
;;;Программа отрисовки обвязки трубопроводов.
;;;Трубопроводы должны быть изображены примитивами Line. Узлами трубопроводов считается совпадение конечных и начальных точек Line.
;;;Пересечение Line между собой узлами не считается.
;;;Для отрисовки обвязки создается слой: O_tr.
;;;Вызов функции: o_tr.
;;;Для изменения параметров использовать глобальные переменные:
;;;*fuzz* - точность совпадения конзов линий.
;;;*scale* - масштаб рисунка.
;;;*l_line* - длина штриха обвязки.
;;;*step* - отступ штриха обвязки от узла трубопровода.
(vl-load-com)
(setq *fuzz* 0.01 ; точность
      *scale* 1.0   ; масштаб
      *l_line* 3.0  ; длина штриха
      *step* 3.0)   ; отступ
; заглавная функция
(defun c:o_tr (/ mspace list_line list_point)
  (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (if (not (tblobjname "LAYER" "O_tr")); создание служебного слоя
    (vla-put-color (vla-add (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))) "O_tr") acYellow)
  )
  (if (vl-catch-all-error-p ; создание списка координат линий
	(setq list_line (vl-catch-all-apply 
	                'o_tr:list_line))); формирование списка координт линий
			(progn
                          (print "\nВыполнение функции прервано при создании списка линий.")
			  (exit)
			)
  )
  (if (vl-catch-all-error-p ; создание списка узлов
	(setq list_point (vl-catch-all-apply 
	                     'o_tr:list_point (list list_line))))
			     (progn
                               (print "\nВыполнение функции прервано при создании списка узлов.")
			       (exit)
			 )
      
  )
  (setq list_point (o_tr:remove_rep list_point)); удаление повторяющихся элементов
  (setq list_point; формирование списка узлов в виде линий '((((x y z) (x y z)) ((x y z) (x y z))) ...)
	 (mapcar '(lambda (x)
		    (vl-remove nil
		      (mapcar '(lambda (y)
			         (cond
				   ((equal x (car y) *fuzz*) (list x (cadr y)))
				   ((equal x (cadr y) *fuzz*) (list x (car y)))
				   (t nil)
			         ))
		      list_line)
		    )
		  )
         list_point)
  )
  (if (vl-catch-all-error-p ; отрисовка обязки
	(vl-catch-all-apply 
	'o_tr:draw_o_tr (list list_point)))
        (progn
  	  (print "Выполнение функции прервано при отрисовке обвязки.")
	  (exit)
	)
  )
  (princ)
)

(princ "\nЗапуск программы - o_tr.")

;**************************************************
(defun o_tr:list_line (/ select); формирование списка координат линий
  (princ "\nSelect line:")
  (setq select (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar (function cadr) (ssnamex (ssget '((0 . "LINE"))))))))
  (mapcar '(lambda (z) (list (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint z)))
			     (vlax-safearray->list (vlax-variant-value (vla-get-endPoint z))))) select)
)
;**************************************************

;**************************************************
(defun o_tr:list_point (list_line /); формирование списка узлов
  (cond
    ((null list_line) nil)
    (t (cons (caar list_line) (cons (cadar list_line) (o_tr:list_point (cdr list_line)))))
  )
)
;**************************************************

;**************************************************
(defun o_tr:remove_rep (list_in / ); удаление повторяющихся элементов списка
  (if list_in
    (if (o_tr:member (car list_in) (cdr list_in))
      (o_tr:remove_rep (cdr list_in))
      (cons (car list_in) (o_tr:remove_rep (cdr list_in)))
    )
  )
)
;**************************************************

;**************************************************
; функция-аналог member для точек с использованием точности при сравнении
(defun o_tr:member (m_element m_list /)
  (cond
    ((null m_list) nil)
    ((equal m_element (car m_list) *fuzz*) t)
    (t (o_tr:member m_element (cdr m_list)))
  )
)
;**************************************************

;**************************************************
(defun o_tr:draw_o_tr (list_point /)
  (mapcar
    '(lambda (x)
       (if (cdr x)
	 (mapcar
	   '(lambda (y)
	      ((lambda (p_1)
	        (vlax-put-property (vla-addline mspace
				     (vlax-3d-point p_1)
		                     (vlax-3d-point (polar p_1 (+ (angle (car y) (cadr y)) (/ pi 2)) (* *scale* *l_line*))))
		"Layer" "O_tr"))
	      (polar (polar (car y) (angle (car y) (cadr y)) (* *scale* *step*)) (- (angle (car y) (cadr y)) (/ pi 2)) (* *scale* (/ *l_line* 2))))
            )      
	 x)
        ) 
     )
  list_point)
)

[fixo]

Сообщение от phantom_l Единственное , хотел немножко уменьшить размер "черточек ", это здесь меняется : (if (equal ip sp1 0.001) ? Вроде единственное число, прошу меня поправить , если не так )

Я задал половину длины черточки = 170. (ищи в коде)
они отстоят от угла на 266. как у тебя на чертеже
Слой "труба" в коде можешь заменить на "0"

~'J'~

[phantom_l]

2fixo
понял , значит мне нужно задать будет где -то 75 , в примере не в мастштабе нарисовано было, но я уже догадываюсь , как это сделать.

[phantom_l]

2Donhuan
Вобще супер ! )) Уже запустил , попробовал . Просто гениально
Только тут нужно черточки увеличить , но это наверное с помощью изменения l_line. Спасибо огромное !
P.S. Нет , сиреневым делать не нужно , это просто для наглядности они другого цвета. А так и тэшки и уголки могут быть одного цвета с трубой, тем более , что принтер ч.б.

[CB]

phantom_l

Тестируй лисп - рисует также и тройники...

Код:

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

(defun c:otv ()
(vl-catch-all-error-p
    (vl-catch-all-apply
      '(lambda (*l_line* *step* *fuzz*)
  ((lambda (lst-point)
   (mapcar
       '(lambda (x)
   ((lambda (start end ang)
      (mapcar
        '(lambda (y / int-point)
    (if (setq
          int-point (inters start
       end
       (car y)
       (cadr y)
      ) ;_ end of inters
        ) ;_ end of setq
      (mapcar
        '(lambda (x)
    (if (equal
          (+ (distance start x)
      (distance x end)
          ) ;_ end of +
          (distance start end)
          *fuzz*
        ) ;_ end of equal
      (entmakex
        (list
          '(0 . "LINE")
          (cons 10
         (polar x
         (+ ang (/ pi 2))
         *l_line*
         ) ;_ end of polar
          ) ;_ end of cons
          (cons 11
         (polar x
         (- ang (/ pi 2))
         *l_line*
         ) ;_ end of polar
          ) ;_ end of cons
        ) ;_ end of list
      ) ;_ end of entmakex
    ) ;_ end of if
         ) ;_ end of lambda
        (list
          (polar int-point ang *step*)
          (polar int-point ang (- *step*))
        ) ;_ end of list
      ) ;_ end of mapcar
    ) ;_ end of if
         ) ;_ end of lambda
        lst-point
      ) ;_ end of mapcar
    ) ;_ end of lambda
     (car x)
     (cadr x)
     (angle (car x) (cadr x))
   )
        ) ;_ end of lambda
       lst-point
     ) ;_ end of mapcar
   ) ;_ end of lambda
    (mapcar '(lambda (ent)
        (mapcar '(lambda (x)
     (cdr (assoc x (entget ent)))
          ) ;_ end of lambda
         '(10 11)
        ) ;_ end of mapcar
      ) ;_ end of lambda
     (vl-remove-if
       'listp
       (mapcar (function cadr)
        (ssnamex (ssget '((0 . "LINE"))))
       ) ;_ end of mapcar
     ) ;_ end of vl-remove-if
    ) ;_ end of mapcar
  )
       ) ;_ end of lambda
      (list
 (/ 3. 2)   ; 3. - длина штриха
 3.    ; отступ
 1e-6    ;точность
      ) ;_ end of list
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of vl-catch-all-error-p
  (princ)
) ;_ end of defun

[phantom_l]

Протестировал - работает. Очень хорошая программа. Очень удобно менять размеры уголков.Спасибо!

[phantom_l]

И вобще , lisp рулит ! Я пока , правда , умею только скачивать чужие програмки и запускать их , но , надеюсь, все еще впереди. ( раньше и запускать не умел )
за программистов ! ))