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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Углы поворота на трассе трубопровода с помощью AutoLISP

Углы поворота на трассе трубопровода с помощью AutoLISP

Ответ
Поиск в этой теме
Непрочитано 23.05.2013, 15:55
Углы поворота на трассе трубопровода с помощью AutoLISP
vahes911
 
Регистрация: 09.03.2012
Сообщений: 10

Здравствуйте товарищи, есть трасса трубопровода 10км (полилиния) на ней множество углов поворота, задача в каждом угле сделать выноску, где на полочке сверху будет - "УП-"+номер по порядку+", а="+величина угла, в низу - "ПК"такой-то+столько-то. Расположение текста желат. выбирать с 3х вариантов - горизонтально, вертикально и перпендикулярно биссектрисе угла. Подскажите есть ли готовые решения (юзал поиск не нашел), если нету сложно ли это осуществить и стоит ли мне разбираться, чтобы написать, может проще и на много быстрее ручками? Спасибо.
Просмотров: 9185
 
Автор темы   Непрочитано 01.06.2013, 10:41
#21
vahes911


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


ну в общем как-то так (вдруг кому понадобится):
Код:
[Выделить все]
 (vl-load-com)
(defun c:qws ( / pln ptLst secP len cnt my_mld spis_att att_old npp disA disB ugolA ugolC)
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn (setq ls nil)
  (repeat (/ (length lst) num)(repeat num (setq ls(cons (car lst) ls)lst (cdr lst)))
  (setq ret (append ret (list (reverse ls))) ls nil)))) ret)  
(defun PLCollect(SelSet / ret)
(foreach lw (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp(mapcar 'cadr(ssnamex SelSet))))
  (cond ((wcmatch (vla-get-ObjectName lw) "*Polyline")
  (setq ret (append ret (group-by-num (vlax-get lw 'Coordinates)
  (if (=(vla-get-ObjectName lw) "AcDbPolyline") 2 3)))))
       ((=(vla-get-ObjectName lw) "AcDbSpline")(setq ret (append ret (group-by-num
         (vlax-safearray->list(vlax-variant-value (vla-get-controlpoints lw)))  3))))
      (t nil))) ret)
(princ "\nВыберите полилинию и нажмите Enter  ")
(setq pln (ssget '((0 . "*POLYLINE"))))
(if pln (setq ptLst(PLCollect pln)))
(if ptLst (progn (princ "\n+++++++ Coordinates list +++++++\n")(setq ptLst (mapcar '(lambda(x)(trans x 0 1)) ptLst))
(mapcar '(lambda(x)(princ(strcat "\n"(rtos(car x))","(rtos(cadr x))
(if(= 3(length x))(strcat ","(rtos(nth 2 x))) "")))) ptLst); end mapcar
(princ "\n\n+++++++++ End of list +++++++++")))
(setq len (length ptLst))
(setq cnt 1)
(while(< cnt (- len 1))
 (progn
  (setq curP (nth cnt ptLst))
  (setq pntA (nth (- cnt 1) ptLst))
  (setq pntC (nth (+ cnt 1) ptLst))
  (setq cnt (+ cnt 1))
  (setq secP (mapcar '+ curP '(0 10 0)))
  (command "_.mleader" curP secP)
  (setq my_mld (entlast))
  (setq spis_att (entget my_mld))
  (setq ugolA (angle pntA curP))
  (setq ugolC (angle curP pntC))
  (setq ugol (fix (- (+ 180 (* ugolA 57.29747)) (* ugolC 57.29747))))
  (if (= ugol 180) (setq ugol 181))
  (setq npp (strcat "УП" (itoa (- cnt 1)) ", a=" (itoa ugol) "°"))
  (setq disA (fix (/ (vlax-curve-getDistAtPoint (ssname pln 0) curP) 100)))
  (setq disB (fix (- (vlax-curve-getDistAtPoint (ssname pln 0) curP) (* disA 100))))
  (setq pkt (strcat "ПК" (itoa disA)  "+" (itoa disB)))
  (setq att_old (cons 302 "NPPum"))
  (setq att_new (cons 302 npp))
  (setq spis_att (subst att_new att_old spis_att))
  (setq att_old (cons 302 "PKTum"))
  (setq att_new (cons 302 pkt))
  (setq spis_att (subst att_new att_old spis_att))
  (entmod spis_att)
  (command "_.rotate" my_mld "" curP "_R" 0 (* ugolA 57.29747))
 ));end progn
)
код так себе, оч много заимствовал с других лиспов, мобильности никакой: применимо для масштаба 1:1000, направление текста по углу 1го отрезка, перед началом необходимо создать формат мультивыноски с блоком который имеет 2 атрибута, 1й чтобы имел значение по умолчанию - NPPum, 2й - PKTum. Всем спасибо кто пытался помочь и за критику.
vahes911 вне форума  
 
Непрочитано 16.05.2014, 12:56
#22
Александр К.

Инженер-программист
 
Регистрация: 17.02.2009
Сообщений: 86


Мастера, приветствую!
Подскажите, а возможно ли вообще сделать программную простановку УГЛОВЫХ размеров?? Да еще и определенных (только острых) углов между сегментами полилинии?? Если да, то подскажите как. (необходимый результат во вложении)
Вершины получил, значения нужных углов получил, но самая загвоздка у меня с простановкой. Как объяснить размеру за что цепляться и в какую сторону выносится?..
Конечная задача как и у топикстартера, но через угловой размер.
Изображения
Тип файла: jpg Угловые размеры.JPG (36.0 Кб, 280 просмотров)
Александр К. вне форума  
 
Непрочитано 16.05.2014, 16:07
#23
nolte

спринклеры, сантехника
 
Регистрация: 26.01.2010
Сообщений: 188
Отправить сообщение для nolte с помощью Skype™


http://forum.dwg.ru/showthread.php?t=102680&page=2
Вариант решения
__________________
Знание лисп: со справочником Н. Полещука
nolte вне форума  
 
Непрочитано 16.05.2014, 16:37
#24
Александр К.

Инженер-программист
 
Регистрация: 17.02.2009
Сообщений: 86


nolte, спасибо за вариант. Но мне хотелось бы работать с угловым размером. А как его правильно нанести (программно) - вот в чем вопрос..
Александр К. вне форума  
 
Непрочитано 16.05.2014, 17:11
#25
nolte

спринклеры, сантехника
 
Регистрация: 26.01.2010
Сообщений: 188
Отправить сообщение для nolte с помощью Skype™


vla-adddimangular
этот метод можно поэксплуатировать "слеганца". правда не совсем уверен на счет правильности, т.к. учусь только, но работать должен
__________________
Знание лисп: со справочником Н. Полещука
nolte вне форума  
 
Непрочитано 16.05.2014, 17:59
#26
Александр К.

Инженер-программист
 
Регистрация: 17.02.2009
Сообщений: 86


Цитата:
Сообщение от nolte Посмотреть сообщение
vla-adddimangular
этот метод можно поэксплуатировать "слеганца". правда не совсем уверен на счет правильности, т.к. учусь только, но работать должен
Лады, попробую поэксплуатировать в понедельник. Но судя по описанию vla-adddimangular - это аналог мной используемой (command "_dimangular" "" Vertex pt1 pt2 pt0), где "" - выбор вершины, Vertex - координаты вершины, pt1, pt2 - точки сторон угла, pt0 - область размещения. Вся проблема в этих pt1, pt2, pt0. А именно при наличии, так сказать, выносных углов. На скриншоте понятнее.
Александр К. вне форума  
 
Непрочитано 17.05.2014, 15:21
#27
nolte

спринклеры, сантехника
 
Регистрация: 26.01.2010
Сообщений: 188
Отправить сообщение для nolte с помощью Skype™


примерно так
Изображения
Тип файла: jpg dwg-dim.JPG (97.2 Кб, 263 просмотров)
__________________
Знание лисп: со справочником Н. Полещука
nolte вне форума  
 
Непрочитано 17.05.2014, 20:10
#28
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,289


Нашелся тут у меня один лиспик. Давно когда-то вставала подобная задача.

----- добавлено через ~37 мин. -----
Должен быть загружен лисп pl-tools.


Добавлено 15.03.2019.
По просьбе qwert88 в #31 функция получила доп. возможность. Код в #32.
Вложения
Тип файла: lsp Dim-in-Vertex.lsp (9.5 Кб, 86 просмотров)

Последний раз редактировалось skkkk, 15.03.2019 в 15:22.
skkkk на форуме  
 
Непрочитано 23.05.2014, 14:28
#29
Александр К.

Инженер-программист
 
Регистрация: 17.02.2009
Сообщений: 86


nolte, спасибо за наглядный алгоритм!
skkkk, спасибо за готовое решение! Немного подрихтовать и самое оно.
Я то пытался на чистом лиспе наваять, видимо через vla проще. Вот пришло время и его изучить.
И еще, объясните доступно (начинающему влашнику), о каком таком параметре идет речь в команде vlax-curvegetEndParam ?? По логике Dim-in-Vertex.lsp, это количество сегментов полилинии. Но все же.. Почему это называется "параметром"?..
Полещука и справку читал. Но не понял.
Изображения
Тип файла: jpg vlax-curve-getEndParam.JPG (28.4 Кб, 225 просмотров)
Александр К. вне форума  
 
Непрочитано 23.05.2014, 15:54
#30
nolte

спринклеры, сантехника
 
Регистрация: 26.01.2010
Сообщений: 188
Отправить сообщение для nolte с помощью Skype™


и объяснялка, что такое параметр в той же книжке.
Изображения
Тип файла: jpg 4444.JPG (137.2 Кб, 218 просмотров)
__________________
Знание лисп: со справочником Н. Полещука
nolte вне форума  
 
Непрочитано 13.03.2019, 11:57
#31
qwert88


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


Всем привет=)
Лисп DIM-IN-VERTEX, который скинул skkkk работает следующим образом (см. Рис.1)
http://forum.dwg.ru/attachment.php?a...1&d=1552467315
А мне нужно следующим образом (см.Рис.2)
http://forum.dwg.ru/attachment.php?a...1&d=1552467327

Подскажите, пожалуйста, может я что-то не так делаю или чего-то не хватает?
Как сделать, чтобы размеры проставлялись по образцу на Рис.2?
Миниатюры
Нажмите на изображение для увеличения
Название: Рис 1.jpg
Просмотров: 52
Размер:	48.5 Кб
ID:	211847  Нажмите на изображение для увеличения
Название: Рис 2.jpg
Просмотров: 54
Размер:	59.6 Кб
ID:	211848  
qwert88 вне форума  
 
Непрочитано 15.03.2019, 15:19
#32
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,289


qwert88, изначально задумка была такой, как на рисунке 1. Но добавить - не проблема (вроде так, как надо сделал, но тестировал очень мало - можно сказать, совсем нет.
В качестве развития функции из #28.
Теперь доступно две команды: см. комментарии в коде.
Код:
[Выделить все]
 ;;; Простановка угловых размеров во всех вершинах всех выбранных полилиний.
;;; Команда DIV1 - проставит углы отклонения каждого последующего сегмента от предыдущего (снаружи угла)
;;; Команда DIV2 - проставит углы между смежными сегментами (внутри угла)
;;; http://forum.dwg.ru/showthread.php?p=1266042#post1266042
(defun C:DIV1 () (dim-in-vertex T))
(defun C:DIV2 () (dim-in-vertex nil))
(defun dim-in-vertex (flag / *error* RTD adoc aspace ss n Dim_Count Vertex_Count NO_Angle_Count Dimmed_Count crv param endparam startparam p1 p2 p1_1 p2_1 turn_ang ptt)
(vl-load-com)
	(defun *error* (msg)
		(if adoc (vla-endundomark adoc))
		(princ)
	) ;defun *error*
	(defun RTD (a)(/ (* a 180.0) pi))
	(setq adoc (vla-get-activedocument (vlax-get-acad-object))
		  ; ss (ssget (list "_:L" (cons 0 "LWPOLYLINE")))
		  n 0
		  Dim_Count 0
		  Vertex_Count 0
		  NO_Angle_Count 0
		  Dimmed_Count 0
	)
	(vla-startundomark adoc)
	(if (= 1 (vla-get-ActiveSpace adoc))
		(setq aspace (vla-get-ModelSpace adoc))
		(setq aspace (vla-get-PaperSpace adoc))
	) ;;;if
	(setq ss (ssget "_I" '((0 . "*POLYLINE"))))
	(sssetfirst nil nil)
	(if (null ss) (setq ss (ssget "_:L" '((0 . "*POLYLINE")))))
	(if ss  
		(repeat (sslength ss)
			(setq crv (vlax-ename->vla-object (ssname ss n))
				  param 0.5
			)
			(pl:VxOpt crv)
			(while (< param (vlax-curve-getEndParam crv))
				(setq endparam (1+ (fix param)) 
					  startparam (1- endparam)
					  p2 (vlax-curve-getPointAtParam crv endparam)
					  p1 (vlax-curve-getPointAtParam crv startparam)
				)
				(if (not (eq endparam (vlax-curve-getEndParam crv)))
					(progn
						(setq p1_1 (vlax-curve-getPointAtParam crv (- endparam 0.6))) 
						(setq p2_1 (vlax-curve-getPointAtParam crv (+ endparam 0.6))) 
						(setq turn_ang (abs (- (RTD (angle p2 p1_1)) (RTD (angle p2 p2_1)))))
						(setq Vertex_Count (1+ Vertex_Count))
						(if (> turn_ang 180) (setq turn_ang (- 360 turn_ang)))
						(setq turn_ang (- 180 turn_ang))
						(if (and (>= turn_ang 1)(null (ssget "_C" (polar p2 (/ pi 4) 0.01) (polar p2 (/ (* 5 pi) 4) 0.01) (list (cons 0 "DIMENSION")))))
							(progn
								(vla-AddDimAngular aspace 
												(vlax-3D-point p2)
												(vlax-3D-point p1_1)
												(vlax-3D-point p2_1)
												(vlax-3D-point (polar 
																	(if flag 
																		(setq ptt (polar p2 (angle p1_1 p2) (distance p1_1 p2)))
																		(setq ptt (polar p2 (angle p2 p1_1) (distance p1_1 p2)))
																	)
																	(angle ptt p2_1)
																	(/ (distance ptt p2_1) 2)
																)
												)
								)
								(setq Dim_Count (1+ Dim_Count))
							) ;;;progn
							(progn
								(if (< turn_ang 1)
									(progn
										(setq NO_Angle_Count (1+ NO_Angle_Count))
									)
								)
								(if (ssget "_C" (polar p2 (/ pi 4) 0.01) (polar p2 (/ (* 5 pi) 4) 0.01) (list (cons 0 "DIMENSION")))
									(progn
										(setq Dimmed_Count (1+ Dimmed_Count))
									)
								)
							) ;;;progn
						)
					) ;;;progn
				) ;;;if
				(setq param (1+ param))
			) ;;;while
			(setq n (1+ n))
		);;;repeat
		(princ "\nНе выбрано ни одной полилинии")
	) ;;;if
	(vla-EndUndoMark adoc)
	(princ (strcat  "\nОбработано полилиний - " (vl-princ-to-string (sslength ss))
					"\nОбработано углов - " (vl-princ-to-string Vertex_Count)
					"\nПроставлено угловых размеров - " (vl-princ-to-string Dim_Count)
					(if (> NO_Angle_Count 0)
						(strcat "\nПропущено углов менее 1 градуса - " (vl-princ-to-string NO_Angle_Count))
						(strcat "")
					)
					(if (> Dimmed_Count 0)
						(strcat "\nПропущено углов, ранее образмеренных - " (vl-princ-to-string Dimmed_Count))
						(strcat "")
					)
			)
	)
	(princ)
)


;;;Функция оптимизирует (удаляет одинаковые с точность до 1e-6 знаков вершины полилинии
;;; pl -ename or vla-object
;;; вовращает имя примитива
(defun pl:VxOpt (pl / vx s_width e_width blg remove _func-lstdel)
  (defun _func-lstdel ( lst / ret i)
    (setq i 0)
    (foreach itm lst
      (if (not (vl-position i remove))
        (setq ret (cons itm ret)))
      (setq i (1+ i))
      )
    (reverse ret)
    )
  (and
   (setq blg (pl-get-coors&width&bulge pl)
       vx (nth 0 blg)
       s_width (nth 1  blg)
       e_width   (nth 2 blg)
       blg (nth 3 blg)
       )
  (or (setq Remove (pl-geom-uniq-vertex-index vx)) t)
  (if (and (> (length vx) 3)
        (equal (car vx)(last vx) 1e-6)
       )
    (progn
    (vla-put-Closed (pl:conv-ent-to-vla pl) :vlax-true)
    (setq Remove (cons (1- (length vx)) Remove))
    )
    Remove
    )
    (setq vx (pl-RemoveNlst Remove vx))
    (setq s_width (pl-RemoveNlst Remove s_width))
    (setq e_width (pl-RemoveNlst Remove e_width))
    (setq blg (pl-RemoveNlst Remove blg))
 
  (PL-SET-COORS&WIDTH&BULGE pl vx s_width e_width blg)
   )
  pl
  )
(princ)

;;;Функция возвращает список координат ширин и кривизн полилинии
;;; pl-ename or vla object
;;; Возвращается список ввиде 4 списков
;;; 1-й список координат (WCS)
;;; 2-й список начальная ширина 
;;; 3-й список конечная ширина
;;; 4-й список кривизн
(defun pl-get-coors&width&bulge ( pl / ent_data tmp_ent start_width end_width blglist coors)
(setq pl (pl:conv-ent-to-ename PL))  
  (setq ent_data (entget pl))
  (if (= (cdr(assoc 0 ent_data))  "LWPOLYLINE")
    (foreach lst ent_data
      (setq num (car lst))
      (cond
        ((= num 10)(setq coors (cons (cdr lst) coors)))
        ((= num 40)(setq start_width (cons (cdr lst) start_width)))
        ((= num 41)(setq end_width (cons (cdr lst) end_width)))
        ((= num 42)(setq blglist (cons (cdr lst) blglist)))
        (t nil)
        )
      )
    (progn
      (setq tmp_ent pl)
      (while (/= "SEQEND" (cdr(assoc 0 (setq ent_data (entget(setq tmp_ent (entnext tmp_ent)))))))
        
             (setq coors (cons (cdr (assoc 10 ent_data))  coors))
             (setq start_width (cons (cdr (assoc 40 ent_data)) start_width))
             (setq end_width (cons (cdr (assoc 41 ent_data)) end_width))
             (setq blglist (cons (cdr (assoc 42 ent_data)) blglist))
	   );_while
      )
    )
  (list (reverse coors)
        (reverse start_width)
        (reverse end_width)
        (reverse blglist)
        )
  )
(princ)

(defun pl-set-coors&width&bulge ( pl coors start_width end_width blglist / ent_data tmp_list i)
(setq pl (pl:conv-ent-to-ename PL))  
(setq ent_data (entget pl))
  (cond ((= (cdr(assoc 0 ent_data))  "LWPOLYLINE")
              (setq ent_data (vl-remove-if
                           '(lambda (x)(vl-position (car x) '(40 41 42 10))) ent_data))
               (mapcar '(lambda (crs sw ew blg)
                          (setq tmp_list (vl-list*
                                              (cons 42 blg)
                                              (cons 41 ew)
                                              (cons 40 sw)
                                              (cons 10 (list (car crs)(cadr crs)))
                                              tmp_list
                                              )
                                        )
                          )
                                     coors start_width end_width blglist
                       )
         
              (setq ent_data (append ent_data (reverse tmp_list)))
              ;(mapcar '(lambda (x) (setq ent_data (append ent_data x))) tmp_list)
              (setq ent_data (subst (cons 90 (fix(* 0.25 (length tmp_list)))) (assoc 90 ent_data) ent_data))
              (entmod ent_data)
              (entupd pl)
	 )
        (t  (setq i (cadddr (assoc 10 ent_data))) ;_Z value
            (setq coors (mapcar '(lambda(x / Z)
                                   (setq Z (caddr x))
                                   (if (null Z)(setq Z i))
                                   (list (car x)(cadr x) Z)) coors))
            (setq tmp_list (apply 'append coors))
            (vla-put-coordinates (setq i (pl:conv-ent-to-vla PL))(vlax-make-variant (vlax-safearray-fill
            (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length tmp_list)))) tmp_list)))
          (setq pl (pl:conv-ent-to-ename i))   
          (setq tmp_list pl i 0)
	 (while (/= "SEQEND" (cdr(assoc 0 (setq ent_data (entget(setq tmp_list (entnext tmp_list)))))))
	   (setq ent_data (entget tmp_list))
	   (if (nth i start_width)
	     (setq ent_data (subst (cons 40 (nth i start_width))(assoc 40 ent_data) ent_data)))
	   (if (nth i end_width)
	     (setq ent_data (subst (cons 41 (nth i end_width))(assoc 41 ent_data) ent_data)))
	   (if (nth i blglist)
	     (setq ent_data (subst (cons 42 (nth i blglist))(assoc 42 ent_data) ent_data)))
           (entmod ent_data)(setq i (1+ i))		 
	   );_while
	; (entmake (cdr (entget tmp_list)))
	 ;(entdel ent_name)
	   (entupd pl)
	 ))
  pl)
(princ)

(defun pl-geom-uniq-vertex-index ( lst / ret prev this i)
  (setq prev (last lst) i (- (length lst) 2))
  (while (not (minusp i))
    (setq this (nth i lst))
    (if (equal prev this 1e-6)
      (setq ret (cons i ret))
      (setq prev this)
      )
    (setq i (1- i))
    )
  ret
  )
(princ)

(defun pl:conv-ent-to-vla (ent_value / ret)
  (cond
    ((= (type ent_value) 'vla-object) ent_value)
    ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
    ((setq ret (pl:conv-ent-to-ename ent_value))(vlax-ename->vla-object ret))
    (t nil)
    ) ;_ end of cond
  ) ;_ end of defun
(princ)

(defun pl:conv-ent-to-ename (ent_value / ret)
  (cond
    ((= (type ent_value) 'vla-object) (vlax-vla-object->ename ent_value))
    ((= (type ent_value) 'ename) ent_value)
    ((and (= (type ent_value) 'list)
          (= (type (setq ret (car ent_value))) 'ename)
          )
     ret
     )
    ((and (= (type ent_value) 'str)(setq ret (handent ent_value))) ret)
    ((= (type ent_value) 'list)(cdr (assoc -1 ent_value)))
    (t nil)
    ) ;_ end of cond
  ) ;_ end of defun
(princ)

  (defun pl-RemoveNlst (nlst lst)
    (setq i -1)
    (vl-remove-if  '(lambda (x) (not (null (vl-position (setq i (1+ i)) nlst)))) lst)
  )
  
  
(princ "\nУтилиты DIM-IN-VERTEX загружен. Введите DIV1 или DIV2 в командной строке.")  
(princ)
Лисп PL-TOOLS все также должен быть загружен в активный сеанс.
skkkk на форуме  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Углы поворота на трассе трубопровода с помощью AutoLISP

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как изменить цвет выбранных примитивов? Замена цвета объектов в autocad (с помощью autolisp). Halfback LISP 8 24.12.2018 20:52
Расстановка номеров пикетов по трассе трубопровода. Jeriko AutoCAD 81 27.07.2015 21:04
Углы поворота пластик. наружного водопровода Инжир Инженерные сети 7 16.03.2012 20:43
Извлечение значений атрибутов блоков AutoCAD Electrical с помощью AutoLisp zaraki_kenpachi LISP 16 19.02.2011 15:30
Конвертация файлов старых версий с помощью AutoLISP kometa AutoCAD 4 12.11.2006 17:25