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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. Длина участка полилинии в выноске?

Lisp. Длина участка полилинии в выноске?

Ответ
Поиск в этой теме
Непрочитано 16.08.2016, 16:15 #1
Lisp. Длина участка полилинии в выноске?
vladant
 
Tula
Регистрация: 14.12.2006
Сообщений: 23

Поиском пользовался, много тем, но все нето.
Lisp. Длина участка полилинии в выноске. Есть кабель освещения на 1.5 км, ручками очень хлопотно строить выноски. Выноска должна показывать расстояние от одной узловой точки до другой, т.е. длина участка. Вид должен быть такой L=(длина участка) м
Просмотров: 5339
 
Непрочитано 16.08.2016, 16:25
#2
ProPeller

Пастух
 
Регистрация: 16.07.2012
Питер
Сообщений: 318


Это вам в поиск исполнителей.
__________________
Автоматизация должна быть автоматической.
ProPeller вне форума  
 
Непрочитано 16.08.2016, 17:49
#3
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


vladant, плохо пользовались поиском, что то подобное на форуме уже было, с автоматическим проставлением длинны сегментов плинии и выравниванием по этому самому сегменту...
Ну и для получения помощи, в данном разделе принято показывать, что уже сами сделали и говорить в чем загвоздка...
Boxa вне форума  
 
Автор темы   Непрочитано 18.08.2016, 01:04
#4
vladant


 
Регистрация: 14.12.2006
Tula
Сообщений: 23


Цитата:
Сообщение от Boxa Посмотреть сообщение
плохо пользовались поиском
если не трудно киньте ссылку, а то все уже перелопатил
vladant вне форума  
 
Непрочитано 18.08.2016, 09:15
#5
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


если один кабель 1,5км разметить-то проще ручками сделать
Сергей812 вне форума  
 
Непрочитано 18.08.2016, 09:35
#6
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Цитата:
Сообщение от vladant Посмотреть сообщение
если не трудно киньте ссылку, а то все уже перелопатил
не кину, я помню, что читал обсуждение подобного и не один раз, но там в итоге скатывались к лисп, а мне это не интересно и я не забивал себе голову. Ищите, вы не первый кто хочет так разметить линии.

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
если один кабель 1,5км разметить-то проще ручками сделать
Зависит от того, сколько загибов на версту...
Boxa вне форума  
 
Непрочитано 18.08.2016, 09:45
1 | #7
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Что-то похожее здесь обсуждали
Добавление в чертеж длины полилинии
То, что выдал гугл
Auto dimension of polylines/lines
Lisp to get length of a polyline and labels the segment length...line or arcs
Polyline segments length
Length Between Intersections
Apply Length Labels At Entity Midpoints
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.08.2016, 09:51
#8
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


Искать в залежах форума - тоже процесс не быстрый. Наверно, это где то в темах либо про кабельные журналы, либо про построение профилей. Что на ум приходит применительно к данной задаче
Сергей812 вне форума  
 
Автор темы   Непрочитано 18.08.2016, 12:25
#9
vladant


 
Регистрация: 14.12.2006
Tula
Сообщений: 23


Цитата:
Сообщение от VVA Посмотреть сообщение
Что-то похожее здесь обсуждали
подскажите как запустить код

Код:
[Выделить все]
(vl-load-com)
(defun pl-segment-length (obj / enParam result j d0 d1 segmentL)
(if (= "AcDbPolyline" (vla-get-ObjectName obj))
(progn
(setq enParam (vlax-curve-getEndParam obj)
j	-1
dtotal (vlax-curve-getDistAtParam obj enParam)
)
(repeat (fix enParam)
(setq j	(1+ j)
d0 (vlax-curve-getDistAtParam obj j)
d1 (vlax-curve-getDistAtParam obj (1+ j))
segmentL (- d1 d0)
result (append result (list (list obj j segmentL)))
)
)
result
)
nil
)
)
(defun c:plseg
(/ s j l item segments *error* minseg maxseg minsegs maxsegs)
(defun *error* (msg)
(if	(not
(member msg (list "Function cancelled" "quit / exit abort"))
)
(princ (strcat "PLSEG Error: " msg))
)
(princ)
)

(if (setq s (ssget (list (cons 0 "LWPOLYLINE"))))
(progn
(setq j -1)
(repeat (sslength s)
(setq
item	(pl-segment-length
(vlax-ename->vla-object (ssname s (setq j (1+ j))))
)
segments (append segments item)
)
)
(setq segments (vl-sort segments
'(lambda (e1 e2) (< (caddr e1) (caddr e2)))
)
minseg (car segments)	; (obj segNo length)
maxseg (car (reverse segments))
minsegs nil
maxsegs nil
)
(foreach l segments
(if (equal (caddr minseg)
(caddr l)
(expt 0.1 (getvar "luprec"))
)
(setq minsegs (append minsegs (list l)))
)
)
(foreach l segments
(if (equal (caddr maxseg)
(caddr l)
(expt 0.1 (getvar "luprec"))
)
(setq maxsegs (append maxsegs (list l)))
)
)
(redraw)
(foreach l minsegs
(grdraw
(vlax-curve-getPointAtParam (car l) (cadr l))
(vlax-curve-getPointAtParam (car l) (1+ (cadr l)))
1
1
)
)
(foreach l maxsegs
(grdraw
(vlax-curve-getPointAtParam (car l) (cadr l))
(vlax-curve-getPointAtParam (car l) (1+ (cadr l)))
5
1
)
)
(princ "\nHighlight RED/Minimum=")
(princ (setq minimum (caddr minseg)))
(princ " and BLUE/Maximum=")
(princ (setq maximum (caddr maxseg)))
(princ ". Clear by REDRAW.")
)
(princ "\nNo object found!!!")
)
(princ)
vladant вне форума  
 
Непрочитано 18.08.2016, 12:30
#10
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


наберите plseg в комстроке
Сергей812 вне форума  
 
Автор темы   Непрочитано 18.08.2016, 12:36
#11
vladant


 
Регистрация: 14.12.2006
Tula
Сообщений: 23


набрал ничего не произошло, толко в ком. строке вышло
Highlight RED/Minimum=0.649479 and BLUE/Maximum=16.1733. Clear by REDRAW.
похоже не то...
будем искать...
vladant вне форума  
 
Непрочитано 18.08.2016, 12:43
#12
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002



Ищите в коде (defun c:plseg - жирным заголовок команды, затем идет имя команды до первой открывающей скобки
Сергей812 вне форума  
 
Автор темы   Непрочитано 18.08.2016, 13:44
#13
vladant


 
Регистрация: 14.12.2006
Tula
Сообщений: 23


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


Код:
[Выделить все]
(defun c:put-dist-2
			    (/		   make_hod_rec	 LWp
			     temp	   adoc		 dist
;;;;;;;;;;;;;;;;;;;;;;;
			     make_hod_rec  make_spline	 add_midl_rec
			     midl_point	   make_lwp	 makedoublesafe
			     geo_vibor
			    )
;;;;;;
;;;;;;make_hod_rec
;;;;;;
  (defun make_hod_rec (_list	    /		 AngleVertexP
		       FirstEndP    SecondEndP	 TextP
		      )
    (cond      
      ((>= (length _list) 2)
       (setq
	 FirstEndP  (car _list)
	 SecondEndP (cadr _list)
	 TextP	    (polar
		      FirstEndP
		      (+ (angle FirstEndP SecondEndP)
			 (/ pi 2)
		      )
		      user_dist_for_put_angle
		    )
       )
       (vla-AddDimAligned
	 (vla-get-modelspace adoc)
	 (vlax-3d-point FirstEndP)
	 (vlax-3d-point SecondEndP)
	 (vlax-3d-point TextP)
       )      
      (make_hod_rec (cdr _list)))
      (t t)
    )
  )

;;;
;;;add_midl_rec
;;;
  (defun add_midl_rec (_list / st-P en_p)
    (cond
      ((cadr _list)
       (setq st-P (car _list)
	     en_p (cadr _list)
       )
       (cons
	 st-P
	 (cons
	   (mapcar (function (lambda (x y) (/ (+ x y) 2.0)))
		   st-P
		   en_p
	   )
	   (add_midl_rec (cdr _list))
	 )
       )
      )
      (t _list)
    )
  )




 
;;;
;;;geo_vibor
;;;
(defun geo_vibor (zap tip sloy exit_ / flag name ru)
  (setq	Flag t
	ru   (= (getvar "SysCodePage") "ANSI_1251")
  )
  (setvar "ERRNO" 0)
  (while Flag
    (setq name
	   (car (entsel zap))
    )
    (cond
					;
      ((and exit_ (= (getvar "ERRNO") 52))
       (setq Flag nil)
      )
      ((not name)
       (princ (if ru
		"\nМимо :( "
		"\nMiss :( "
	      )
       )
      )
					;
      ((not
	 (wcmatch (cdr (assoc 0 (entget name)))
		  tip
	 )
       )
       (princ
	 (strcat
	   (if ru
	     "\n Не верный объект, должен быть: "
	     "\n Bad object that must be: "
	   )
	   tip
	 )
       )
      )
					;
      ((not
	 (wcmatch (cdr (assoc 8 (entget name)))
		  sloy
	 )
       )
       (princ
	 (strcat
	   (if ru
	     "\nВыбран объект не на том слое, должен быть "
	     "\nSelected object not on the right layer, must be "
	   )
	   sloy
	 )
       )
      )
					;
      (t
       (setq Flag nil
	     name name
       )
      )
					;
    )
  )
)

;;;
;;;group-by-num
;;;
(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
)
;;;;;;;;;;;;;;;;;;;;;;;;  
  (vl-load-com)
  (initget 7)
  (setq user_dist_for_put_angle
	     (getdist
		     
			"\nЗначение отступа <"
			
		      
	     ))
  (While (setq LWp
	     (geo_vibor
	       "\nУкажите (полилинию) <Выход>: "
	       "LWPOLYLINE"
	       "*"
	       t
	     )
      )
    (progn
      (or user_dist_for_put_angle
	  (setq user_dist_for_put_angle 20)
      )
      (setq
	point_list
	 (group-by-num
	   (vlax-get
	     (vlax-ename->vla-object
	       LWp
	     )
	     'Coordinates
	   )
	   2
	 )
	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
	point_list (add_midl_rec
;;;		     (append
		       point_list
;;;		       (list(car point_list))
;;;		       )
	)
      )
      (vla-startundomark adoc)
      (make_hod_rec point_list)
      (vla-endundomark adoc)
    )
  )
)
vladant вне форума  
 
Непрочитано 18.08.2016, 14:24
#14
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


ПОдпись у VVA не просмотреть, что ли?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 18.08.2016, 18:58
1 | #15
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от vladant Посмотреть сообщение
но только делит эти размеры на две части полилинии
Держи
Код:
[Выделить все]
(defun c:put-dist (/		 make_hod_rec  LWp
		   temp		 adoc	       dist
		   make_hod_rec	 make_spline   add_midl_rec
		   midl_point	 make_lwp      makedoublesafe
		   geo_vibor
		  )
;;;;;;
;;;;;;make_hod_rec
;;;;;;
  (defun make_hod_rec (_list	    /		 AngleVertexP
		       FirstEndP    SecondEndP	 TextP
		      )
    (cond
      ((>= (length _list) 2)
       (setq
	 FirstEndP  (car _list)
	 SecondEndP (cadr _list)
	 TextP	    (polar
		      FirstEndP
		      (+ (angle FirstEndP SecondEndP)
			 (/ pi 2)
		      )
		      user_dist_for_put_angle
		    )
       )
       (vla-AddDimAligned
	 (vla-get-modelspace adoc)
	 (vlax-3d-point FirstEndP)
	 (vlax-3d-point SecondEndP)
	 (vlax-3d-point TextP)
       )
       (make_hod_rec (cdr _list))
      )
      (t t)
    )
  )
;;;
;;;geo_vibor
;;;
  (defun geo_vibor (zap tip sloy exit_ / flag name ru)
    (setq Flag t
	  ru   (= (getvar "SysCodePage") "ANSI_1251")
    )
    (setvar "ERRNO" 0)
    (while Flag
      (setq name
	     (car (entsel zap))
      )
      (cond
	((and exit_ (= (getvar "ERRNO") 52))
	 (setq Flag nil)
	)
	((not name)
	 (princ	(if ru
		  "\nМимо :( "
		  "\nMiss :( "
		)
	 )
	)
	((not
	   (wcmatch (cdr (assoc 0 (entget name)))
		    tip
	   )
	 )
	 (princ
	   (strcat
	     (if ru
	       "\n Не верный объект, должен быть: "
	       "\n Bad object that must be: "
	     )
	     tip
	   )
	 )
	)
	((not
	   (wcmatch (cdr (assoc 8 (entget name)))
		    sloy
	   )
	 )
	 (princ
	   (strcat
	     (if ru
	       "\nВыбран объект не на том слое, должен быть "
	       "\nSelected object not on the right layer, must be "
	     )
	     sloy
	   )
	 )
	)
	(t
	 (setq Flag nil
	       name name
	 )
	)
      )
    )
  )

;;;
;;;group-by-num
;;;
  (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
  )
;;;;;;;;;;;;;;;;;;;;;;;;  
  (vl-load-com)
  (initget 7)
  (setq	user_dist_for_put_angle
	 (getdist

	   "\nЗначение отступа <"


	 )
  )
  (While (setq LWp
		(geo_vibor
		  "\nУкажите (полилинию) <Выход>: "
		  "LWPOLYLINE"
		  "*"
		  t
		)
	 )
    (progn
      (or user_dist_for_put_angle
	  (setq user_dist_for_put_angle 20)
      )
      (setq
	point_list
		   (group-by-num
		     (vlax-get
		       (vlax-ename->vla-object
			 LWp
		       )
		       'Coordinates
		     )
		     2
		   )
	adoc	   (vla-get-activedocument
		     (vlax-get-acad-object)
		   )
      )
      (vla-startundomark adoc)
      (make_hod_rec point_list)
      (vla-endundomark adoc)
    )
  )
  (princ)
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 21.08.2016, 14:01
#16
vladant


 
Регистрация: 14.12.2006
Tula
Сообщений: 23


Цитата:
Сообщение от VVA Посмотреть сообщение
Держи
Спасибо, все работает, единственно только, вместо команд в ком. строке вопросит. знаки

Последний раз редактировалось Кулик Алексей aka kpblc, 22.08.2016 в 10:53.
vladant вне форума  
 
Непрочитано 21.08.2016, 15:12
1 | #17
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


Кодировка, извечная проблема как редактора VLISP, так и VBA. Чтобы корректно копировалось - и в браузере, и куда копируете - сначала ставите русскую раскладку. А лишь потом копируете
Сергей812 вне форума  
 
Непрочитано 22.08.2016, 10:53
#18
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


vladant, картинку не видно! Кто мешает к посту прикладывать материалы?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. Длина участка полилинии в выноске?

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ищу функцию построения 3d полилинии mankurt Программирование 8 07.02.2012 12:43
Умер разработчик языка программирования Lisp andr_g LISP 1 27.10.2011 08:36
{Конкурс} Lisp. Задачки для студентов gomer LISP 10 05.01.2011 16:33
выноски к полилинии gizmo_zx Программирование 6 01.03.2010 12:17
Можно ли автоматически свести в таблицу дирекционные углы отрезков полилинии? mvz AutoCAD 2 27.08.2008 07:47