[jackUAROBEY]

Добрый день. Написал программку для сетей НВК. Прошу затестить. Критика приветствуется.
Команды naporna_ya Samotechna_ya.

С помощью этой программы вы сможете быстро расставить колодцы на самотечных сетях канализации, пронумеровать их и указать диаметр и длину участка между колодцами. На напорных сетях последовательно расставить пикеты, углы поворота, диаметр и наименование напорного трубопровода. Все что требуется для корректной работы программы это правильно построенная полилиния. Для самотечного коллектора необходимо проставить вершины в местах где будут колодцы. Для напорного коллектора указать вершины полилинии в углах поворота.

Типа инструкция https://www.youtube.com/embed/Mi0SjPv0JdA

Обновление 14.02.2018

Программу можно качнуть https://apps.autodesk.com/ACD/ru/Det...ru&os=Win32_64

[Apelsinov]

jackUAROBEY,
Я не тестил твою программу, ибо мне не очень надо, мне кажется такая прога не очень универсальна и сильно труд не облегчит.
Мне не очень понравился код - слишком много переменных, и немного, на мой взгляд, коряво - хотя в целом впечатляет.

Но мне интересна тема разработки лиспа под ВК и наружку, и хочется это обсуждать.
Видно, что в программу вложено много труда и знаний. И спасибо за видео - сразу позволяет оценить что же она делает.

Сначала я хотел дать комментарии к коду, но уж слишком много букв

Я тут поделюсь своей разработкой - это программа для отрисовки профилей.
https://youtu.be/AGrj3zZp2WY
Запуск: (apel-com '(apel-draw-profil))
блоки необходимые для работы программы тут:
template_profil.dwg
библиотечные функции - по ссылке у меня в подписи - я только что обновил там файл. Это FAS - там много функций, если заинтересует какая-то конкретно - я дам код.
(вот ссылка, если не открывается что в подписи: APEL.ZIP)

Код:

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

 (defun apel-draw-profil	(/	   list_blk_0	       list_blk_1	   list_blk_2	       list_blk_3	   list_blk_4	       list_blk_5	   list_blk_6	       blk_obj_in
			 blk_obj   list_pl_obj	       list_pls	 list_blk_att	     max_min   list_ptlot	   F1	     F2	       F3	 F4	   F5	     F6	       F7	 F8
			 F9	   F10	     F11       F12	 F13	   F14	     F15       F16	 F17	   F18	     F19       F20	 F21	   F22
			)
;;;******ЛОКАЛЬНЫЕ ФУНКЦИИ F1-F22******
  (defun F1 (/ a)
;;;Проверка наличия блоков в файле
;;;  арг: нет
;;;  воз: T, если все блоки есть, либо nil
    (if	(not (setq a (vl-remove-if
		       'null
		       (mapcar 'APEL-BLOCK-P
			       (list
				 "APEL_BLOCK_PROFIL_REPER1"		"APEL_BLOCK_PROFIL_REPER2"	       "APEL_BLOCK_PROFIL_REPER3"	      "APEL_BLOCK_PROFIL_REPER4_1"
				 "APEL_BLOCK_PROFIL_REPER4_2"		"APEL_BLOCK_PROFIL_REPER4_3"	       "APEL_BLOCK_PROFIL_REPER5_1"	      "APEL_BLOCK_PROFIL_REPER5_2"
				 "APEL_BLOCK_PROFIL_REPER6_1"		"APEL_BLOCK_PROFIL_REPER6_2"	       "APEL_BLOCK_PROFIL_REPER6_3"	      "APEL_BLOCK_PROFIL_REPER6_4"
				 "APEL_BLOCK_PROFIL_REPER7"		"APEL_BLOCK_PROFIL_TABLE"	       "APEL_BLOCK_PROFIL_TABL_OTM"	      "APEL_BLOCK_PROFIL_TABL_OTM_1"
				 "APEL_BLOCK_PROFIL_PL1"		"APEL_BLOCK_PROFIL_PL2"		       "APEL_BLOCK_PROFIL_PL3"
				)
		       )
		     )
	     )
	)
      (princ
	"\n Ошибка: Для отрисовки профиля нет необхоимых блоков!\n"
      )
    )
    a
  )
;;;--------------------------------------
  (defun F2 (/ list_blk)
;;;  Запрос на ввод данных, выделение блоков и назначение масштабов
;;;  арг: нет
;;;  воз: список выделенных блоков, либо nil
    (if	(apel-config-read '*apel-draw-profil_scale*)
      (setq *mv* (car *apel-draw-profil_scale*)
	    *mg* (cadr *apel-draw-profil_scale*)
      )
      (setq *mv* 100
	    *mg* 1000
      )
    )
    (princ
      (strcat "\n Масштаб по вертикали / Масштаб по горизонтали: "
	      (rtos *mv* 2 0)
	      " / "
	      (rtos *mg* 2 0)
	      "\n"
      )
    )
    (initget "Draw Scale")
    (if	(eq (GETKWORD "[Draw_profil/Scale] <Draw>:") "Scale")
      (and (null (initget 6))
	   (setq *mv* (cond ((GETINT
			       (strcat "\n Enter vertical scale <"
				       (rtos *mv* 2 0)
				       ">:"
			       )
			     )
			    )
			    (*mv*)
		      )
	   )
	   (null (initget 6))
	   (setq *mg* (cond ((GETINT
			       (strcat "\n Enter gorizontal scale <"
				       (rtos *mg* 2 0)
				       ">:"
			       )
			     )
			    )
			    (*mg*)
		      )
	   )
	   (APEL-CONFIG-WRITE
	     '*apel-draw-profil_scale*
	     (list *mv* *mg*)
	   )
      )
    )
    (princ
      (strcat "\n Масштаб по вертикали / Масштаб по горизонтали: "
	      (rtos *mv* 2 0)
	      " / "
	      (rtos *mg* 2 0)
	      "\n"
      )
    )
    (if	(setq list_blk (APEL-SSGET-LIST
			 (list '((0 . "INSERT")
;;;				 (-4 . "<OR")
;;;				 (2 . "APEL_BLOCK_PROFIL_R1")
;;;				 (2 . "APEL_BLOCK_PROFIL_R2")
;;;				 (2 . "APEL_BLOCK_PROFIL_R3")
;;;				 (-4 . "OR>")
				)
			 )
			 "\nSelect blocks:"
			 nil
		       )
	)
      (VL-REMOVE-IF-NOT
	(function
	  (lambda (i)
	    (member (APEL-MOD-GET_PROPERTY i "EffectiveName")
	    '("APEL_BLOCK_PROFIL_R1"
	      "APEL_BLOCK_PROFIL_R2"
	      "APEL_BLOCK_PROFIL_R3"
	     ))
	  )
	)
	list_blk
      )
    )
  )
;;;--------------------------------------
  (defun F3 (list_blk /	list_blk list_blk1 list_blk2 list_blk3 list_blk_att)
;;; Получение ассоциативного списка по атрибутам
;;;  арг: list_blk - список выделенных блоков
;;;  воз: ассоциативный список, либо nil
;;;    В ассоц списке первое значение по атрибуту вставок блоков:
;;;    N - номер блока по порядку (не должен повторяться)
;;;    Z - отм. проектная земля
;;;    Z_NAT - отм. натурная земля
;;;    N_prof - наименование точки на профиле
;;;    L - отметка лотка трубы
;;;    L1 - вторая отметка лотка, если перепадной
;;;    D - диаметр трубы,
;;;    p - обозначение на профиле  (для блоков R3 и R2)
;;;    P_OT - отметка пересекаемой сети (для блоков R2)
            (and (setq list_blk_att
		(mapcar	(FUNCTION
			  (lambda (i)
			      ; Получаем список характеристик блоков типа ((("PT" (14.2334 88.9727 0.0)) ("N" "1") ("Z" "42.2")("L" "40.2"))))
			    (cons
			      (list
				"PT"
				(APEL-POINT-VARIANT_TO_LIST
				  (APEL-MOD-GET_PROPERTY
				    i
				    'InsertionPoint
				  )
				)
			      )
			      (cons
				(list
				  "TYPE"
				  (cond
				    ((eq (setq bname
						(APEL-MOD-GET_PROPERTY
						  i
						  "EffectiveName"
						)
					 )
					 "APEL_BLOCK_PROFIL_R1"
				     )
				     "R1"
				    )
				    ((eq bname "APEL_BLOCK_PROFIL_R2")
				     "R2"
				    )
				    ((eq bname "APEL_BLOCK_PROFIL_R3")
				     "R3"
				    )
				  )
				)
				(APEL-BLOCK-GET-ATTRIBUTES i)
			      )
			    )
			  )
			)
			list_blk
		)
	 )
	 (setq list_blk_att
		(vl-sort      ; Сортируем список по значениям параметра N
		  list_blk_att
		  (FUNCTION
		    (lambda (i1 i2)
		      (< (apel-atof (cadr (assoc "N" i1)))
			 (apel-atof (cadr (assoc "N" i2)))
		      )
		    )
		  )
		)
	 )
    )
    list_blk_att
  )
;;;--------------------------------------
  (defun F4 (list_blk_att / list_N)
;;; Проверка ассоциативного списка на параметр N порядковый номер
;;;  арг: list_blk_att - ассоциативный список
;;;  воз: T, если все впорядке, либо nil
    (null (vl-remove-if
	    'null
	    (mapcar
	      (FUNCTION
		(lambda	(i / N)
		  (if (setq
			mess
			 (cond
			   ((null (setq N (cadr (assoc "N" i))))
			    "Нет атрибута порядкового номера!"
			   )
			   ((null (WCMATCH N "*#*"))
			    (strcat "Порядковый номер \"" N "\" не цифра!")
			   )
			   ((or	(member N list_N)
				(member (VL-STRING-TRANSLATE "," "." N) list_N)
			    )
			    (strcat "Порядковый номер \"" N "\" повторяется!")
			   )
			 )
		      )
		    (princ (strcat "\n Ошибка: " mess "\n"))
		  )
		  (setq list_N (cons N list_N))
		  mess
		)
	      )
	      list_blk_att
	    )
	  )
    )
  )
;;;--------------------------------------
  (defun F5 (list_blk_att / list_N)
;;; Проверка ассоциативного списка на значения атрибутов блоков
;;;  арг: list_blk_att - ассоциативный список
;;;  воз: T, если все впорядке, либо nil
    (null
      (vl-remove-if
	'null
	(mapcar
	  (FUNCTION
	    (lambda (i / mess B_TYPE N_prof Z L L1 D P P_OT)
	      (if (setq	mess
			 (cond
			   ((eq "R1" (cadr (assoc "TYPE" i)))
			    (cond
			      ((null
				 (and
				   (setq B_TYPE "Колодец")
				   (setq N_prof (cadr (assoc "N_prof" i)))
				   (setq Z (cadr (assoc "Z" i)))
				   (setq L (cadr (assoc "L" i)))
				   (setq L1 (cadr (assoc "L1" i)))
				   (setq D (cadr (assoc "D" i)))
				 )
			       )
			       "Нет необходимых атрибутов!"
			      )
			      ((null (WCMATCH Z "*#*"))
			       (strcat "Отметка проектной земли \""
				       Z
				       "\" не верна!"
			       )
			      )
			      ((null (WCMATCH L "*#*"))
			       (strcat "Отметка лотка \""
				       L
				       "\" не верна!"
			       )
			      )
			      ((null (WCMATCH D "*#*"))
			       (strcat "Диаметр \"" D "\" не верен!")
			      )
			    )
			   )
			   ((eq "R2" (cadr (assoc "TYPE" i)))
			    (cond
			      ((null (and
				       (setq B_TYPE "Пересечение")
				       (setq Z (cadr (assoc "Z" i)))
				       (setq P (cadr (assoc "P" i)))
				       (setq P_OT (cadr (assoc "P_OT" i)))
				     )
			       )
			       "Нет необходимых атрибутов!"
			      )
			      ((null (WCMATCH Z "*#*"))
			       (strcat "Отметка проектной земли \""
				       Z
				       "\" не верна!"
			       )
			      )
			      ((null (WCMATCH P_OT "*#*"))
			       (strcat "Отметка пересекаемой сети \""
				       P_OT
				       "\" не верна!"
			       )
			      )
			    )
			   )
			   ((eq "R3" (cadr (assoc "TYPE" i)))
			    (cond
			      ((null (and (setq B_TYPE "Рельеф")
					  (setq Z (cadr (assoc "Z" i)))
					  (setq P (cadr (assoc "P" i)))
				     )
			       )
			       "Нет необходимых атрибутов!"
			      )
			      ((null (WCMATCH Z "*#*"))
			       (strcat "Отметка проектной земли \""
				       Z
				       "\" не верна!"
			       )
			      )
			    )
			   )
			 )
		  )
		(princ (strcat "\n Ошибка: "
			       B_TYPE
			       ". Номер "
			       (cadr (assoc "N" i))
			       " - "
			       mess
			       "\n"
		       )
		)
	      )
	    )
	  )
	  list_blk_att
	)
      )
    )
  )
;;;--------------------------------------
  (defun F6 (list_blk_att / pt old_pt l_dist)
;;; добавление в ассоц. список расстояний между точками вставки блоков
;;;  арг: list_blk_att - ассоциативный список
;;;  воз: список по блокам как исходный но с доб. с тэгом "DIST"
    (reverse (mapcar
	       (FUNCTION
		 (lambda (i)
		   (setq pt (cadr (assoc "PT" i)))
		   (setq
		     l_dist (list
			      "DIST"
			      (cond
				(old_pt
				 (distance old_pt pt)
				)
				(0.0)
			      )
			    )
		   )
		   (setq old_pt pt)
		   (cons l_dist i)
		 )
	       )
	       (reverse list_blk_att)
	     )
    )
  )
;;;--------------------------------------
  (defun F7 (list_blk_att / bt_distx base_point dist pt old_pt)
;;;  Добавление в список точек вставок блоков для профиля
;;;  арг: list_blk_att - ассоциативный список
;;;  воз: аналогичный список, но с добавлеными точками с тэгом "P_0"
    (setq bt_distx 15)	      ; расстояние от б.т. до отрисовки профиля по х
    (setq base_point '(0.0 0.0 0.0))
    (mapcar
      (FUNCTION
	(lambda	(i)
	  (setq
	    pt (cond (old_pt
		      (list
			(+ (car old_pt) (/ dist *mg*))
			(cadr base_point)
			(caddr base_point)
		      )
		     )
		     ((list
			(+ (car base_point) bt_distx)
			(cadr base_point)
			(caddr base_point)
		      )
		     )
	       )
	  )
	  (setq dist (cadr (assoc "DIST" i)))
	  (cons (list "PT_0" (setq old_pt pt)) i)
	)
      )
      list_blk_att
    )
  )
;;;--------------------------------------
  (defun F8 (list_blk_att / bt_disty)
;;;  Определение мин и мах отметок из всех имеющихся (план.земля, нат.земля, лот.тр, пересекаемые комм.)
;;;  причем отметки целые, т.е. минимальная - это горизонт, т.е. верх таблицы, а макс. это самая большая из елки.
;;;  арг: list_blk_att - ассоциативный список
;;;  воз: '(максимальная_отметка минимальная_отметка )
    (setq bt_disty 3)	      ; минимальное расстояние снизу до таблицы в метрах
    (setq list_otm
	   (mapcar
	     'APEL-ATOF
	     (mapcar
	       'cadr
	       (apply 'append
		      (mapcar (FUNCTION	(lambda	(i)
					  (VL-REMOVE-IF
					    'null
					    (list (assoc "L" i)
						  (assoc "Z" i)
						  (assoc "Z_NAT" i)
						  (assoc "P_OT" i)
					    )
					  )
					)
			      )
			      list_blk_att
		      )
	       )
	     )
	   )
    )
    (list (fix (1+ (apply 'max list_otm)))
	  (fix (- (apply 'min list_otm) bt_disty))
    )
  )
;;;--------------------------------------
  (defun F9 (max_min list_blk_att / list_point)
;;;    Определение точек отрисовки п.линий трубы
    ;;  арг: max_min - спискок макс и мин точек
;;;   	  list_blk_att - ассоциативный список
;;;  воз: ((список пар точек лотка)(список пар точек верха))
    (if	(setq list_point
	       (VL-REMOVE-IF
		 'null
		 (mapcar
		   (FUNCTION
		     (lambda (i / L L1 D PT_0 PT_t1_1 PT_t1_2 PT_t2_1 PT_t2_2)
;;;		  PT_0 - точка вставки блока табличных отметок
;;;		  PT_t1_1 - т.лотка исходящей трубы
;;;		  PT_t1_2 - т.верха исходящей трубы
;;;		  PT_t2_1 - т.лотка входящей трубы
;;;		  PT_t2_2 - т.верха входящей трубы
		       (if
			 (and (setq L (cadr (ASSOC "L" i)))
			      (setq L (apel-atof L))
			      (setq L1 (cadr (ASSOC "L1" i)))
			      (setq L1 (apel-atof L1))
			      (setq PT_0 (cadr (ASSOC "PT_0" i)))
			      (setq D (cadr (ASSOC "D" i)))
			      (setq D (apel-atof D))
			      (setq PT_t1_1
				     (list
				       (car PT_0)
				       (/ (* 1000
					     (-	L
						(cadr max_min)
					     )
					  )
					  *mv*
				       )
				       (caddr PT_0)
				     )
			      )
			      (setq
				PT_t1_2	(list
					  (car PT_0)
					  (+ (/ D *mv*) (cadr PT_t1_1))
					  (caddr PT_0)
					)
			      )
			      (setq
				PT_t2_1
				 (cond
				   ((null old_D) "")
				   ((/= L1 0.0)
				    (list
				      (car PT_0)
				      (/ (* 1000
					    (- L1
					       (cadr max_min)
					    )
					 )
					 *mv*
				      )
				      (caddr PT_0)
				    )
				   )
				   ((null (eq old_D D))
				    (list
				      (car PT_0)
				      (/ (+ (* 1000
					       (- L
						  (cadr max_min)
					       )
					    )
					    (- D old_D)
					 )
					 *mv*
				      )
				      (caddr PT_0)
				    )
				   )
				   (PT_t1_1)
				 )
			      )
			      (setq
				PT_t2_2
				 (if (eq PT_t2_1 "")
				   PT_t2_1
				   (list
				     (car PT_0)
				     (+ (/ old_D *mv*) (cadr PT_t2_1))
				     (caddr PT_0)
				   )
				 )
			      )
			      (setq old_D D)
			 )
			  (list PT_t1_1 PT_t1_2 PT_t2_1 PT_t2_2)
		       )
		     )
		   )
		   list_blk_att
		 )
	       )
	)
      (list
	(APEL-TRANSP-DUGL_VILSON
	  (list	(reverse (cdr (reverse (mapcar 'car list_point))))
		(cdr (mapcar 'caddr list_point))
	  )
	)
	(APEL-TRANSP-DUGL_VILSON
	  (list	(reverse (cdr (reverse (mapcar 'cadr list_point))))
		(cdr (mapcar 'cadddr list_point))
	  )
	)
      )
    )
  )
;;;--------------------------------------
  (defun F10 (max_min list_blk_att /)
;;;  Получение точек п.л. профилeй
;;;  арг: max_min - спискок макс и мин точек
;;;   	  list_blk_att - ассоциативный список
;;;  воз: (точки пл.земли)(натур.земли)
    (mapcar
      (FUNCTION
	(lambda	(Z)
	  (VL-REMOVE-IF
	    'null
	    (mapcar
	      (FUNCTION
		(lambda	(i / a b)
		  (if (and (setq a (cadr (ASSOC Z i)))
			   (setq b (cadr (ASSOC "PT_0" i)))
		      )
		    (list
		      (car b)
		      (/ (* 1000 (- (apel-atof a) (cadr max_min)))
			 *mv*
		      )
		      (caddr b)
		    )
		  )
		)
	      )
	      list_blk_att
	    )
	  )
	)
      )
      (list "Z" "Z_NAT")
    )
  )
;;;--------------------------------------
  (defun F11 (/ blk_obj N)
;;;  Создание блока профиля с уникальным именем (все объекты профиля потом засунем в этот блок)
;;;  арг: нет
;;;  воз: объект блока
    (while (null blk_obj)
      (setq N (cond (N (1+ N))
		    (1)
	      )
      )
      (setq
	blk_obj	(apel-block-add_document
		  (strcat "APEL-DRAW-PROFIL_"
			  (rtos (apel_rand) 2 0)
			  (rtos N 2 0)
		  )
		)
      )
    )
    blk_obj
  )
;;;--------------------------------------
  (defun F12 (list_pls list_ptlot blk_obj /)
;;;  Отрисовка полилиний по спискам list_pls в блоке blk_obj
;;;  арг: list_pls - список точек для полилиний
;;;       blk_obj - блок для отрисовки п.л.
;;;  воз: список объектов п.л.
    (list
      (F22 blk_obj (car list_pls) "APEL_BLOCK_PROFIL_PL1")
			      ; земля проектная
      (F22 blk_obj (cadr list_pls) "APEL_BLOCK_PROFIL_PL2")
			      ; земля натурная
      (mapcar (FUNCTION	(lambda	(z)
			  (F22 blk_obj z "APEL_BLOCK_PROFIL_PL3")
			      ; низ трубы
			)
	      )
	      (car list_ptlot)
      )
      (mapcar (FUNCTION	(lambda	(z)
			  (F22 blk_obj z "APEL_BLOCK_PROFIL_PL3")
			      ; верх трубы (или наоборот, хз)
			)
	      )
	      (cadr list_ptlot)
      )
    )
  )
;;;--------------------------------------
  (defun F13 (max_min blk_obj list_pls / blk_list blk_0	blk_1 pt_0 y_min y_max)
;;;  Вставка блоков таблицы и елки отметок
;;;  арг: max_min - спискок макс и мин точек
;;;       blk_obj - блок профиля
;;;  воз: список объектов блоков
    (setq pt_0 (list 0.0 0.0 0.0))
    (setq y_min (cadr max_min))
    (setq y_max (car max_min))
    (if	(setq blk_0 (vla-InsertBlock ; Вставляем блок таблицы под профилем нет проверок на наличие блоков
		      blk_obj
		      (APEL-POINT-LIST_TO_VARIANT pt_0)
		      "APEL_BLOCK_PROFIL_TABLE"
		      1
		      1
		      1
		      0
		    )
	)
      (APEL-BLOCK-PUT-ATTRIBUTES
	blk_0
	(list
	  (list "MV" (APEL-RTOS 0 *mv*))
	  (list "MG" (APEL-RTOS 0 *mg*))
	)
      )
    )
    (while (< y_min y_max)    ;Вставка блоков отметок над таблицей профиля
      (setq pt_0
	     (list (car pt_0)
		   (+ (/ 1000 *mv*) (cadr pt_0))
		   (caddr pt_0)
	     )
      )
      (setq blk_list (cons (setq blk_1 (vla-InsertBlock
					 blk_obj
					 (APEL-POINT-LIST_TO_VARIANT pt_0)
					 "APEL_BLOCK_PROFIL_TABL_OTM"
					 1
					 1
					 1
					 0
				       )
			   )
			   blk_list
		     )
      )
      (setq y_min (1+ y_min))
      (APEL-BLOCK-PUT-ATTRIBUTES
	blk_1
	(list (list "H" (strcat (apel-rtos 0 y_min) ",00")))
      )
      (vla-InsertBlock	      ; вставка линии от отметки до конца профиля
	blk_obj
	(APEL-POINT-LIST_TO_VARIANT
	  (list (+ 7 (car pt_0)) (cadr pt_0) (caddr pt_0))
	)
	"APEL_BLOCK_PROFIL_TABL_OTM_1"
	(car (car (reverse (car list_pls))))
	1
	1
	0
      )
      (cons blk_0 blk_list)
    )
    (cons (mapcar
	    (FUNCTION (LAMBDA (i) ; вставка линий таблицы
			(vla-InsertBlock
			  blk_obj
			  (APEL-POINT-LIST_TO_VARIANT i)
			  "APEL_BLOCK_PROFIL_TABLE_1"
			  (+ 7 (car (car (reverse (car list_pls)))))
			  1
			  1
			  0
			)
		      )
	    )
	    (mapcar (FUNCTION (lambda (i) (list 0.0 (* -1.0 i) 0.0)))
		    (list 0 15 30 45 51 66 76 86 96 106)
	    )
	  )
	  blk_list
    )
  )
;;;--------------------------------------
  (defun F14 (list_blk_att blk_obj / list_blk)
;;;  вставка цифровых блоков по колодцам blk_1
;;;  арг: list_blk_att - ассоциативный список
;;;       blk_obj - блок профиля
;;;  воз: список объектов блоков
    (mapcar
      (FUNCTION	(lambda	(i / blk)
		  (if (and
			(assoc "L" i)
			(setq blk (vla-InsertBlock
				    blk_obj
				    (APEL-POINT-LIST_TO_VARIANT
				      (cadr (assoc "PT_0" i))
				    )
				    "APEL_BLOCK_PROFIL_REPER2"
				    1
				    1
				    1
				    0
				  )
			)
			(setq list_blk (cons blk list_blk))
		      )
		    (APEL-BLOCK-PUT-ATTRIBUTES
		      blk
		      (list
			(list "N" ; порядковый номер точки
			      (cadr (assoc "N" i))
			)
			(list "Z_NAT" ; натурная земля
			      (cadr (assoc "Z_NAT" i))
			)
			(list "Z" ; проектируемая земля
			      (cadr (assoc "Z" i))
			)
			(list "L" ; труба
			      (cadr (assoc "L" i))
			)
			(list "L1" ; труба
			      (cadr (assoc "L1" i))
			)
			(list "N_prof" ; Обозначение точки
			      (cadr (assoc "N_prof" i))
			)
		      )
		    )
		  )
		)
      )
      list_blk_att
    )
    list_blk
  )
;;;--------------------------------------
  (defun F15 (list_blk_att list_ptlot / list_lot old_l old_PT old_PT_0)
;;;  Получение списка для вставки промежуточных блоков с уклоном и расстоянием
;;;  арг: list_blk_att - ассоциативный список
;;;    	  list_ptlot - список точек по трубе, возвращаемый F9
;;;  воз: список для установки блоков
    (mapcar
      'cons
      (mapcar (FUNCTION
		(lambda	(i)
		  (list	"U"
			(apel-rtos 4
				   (/ (* *mv* (- (cadar i) (cadadr i)))
				      (* *mg* (- (caadr i) (caar i)))
				   )
			)
		  )
		)
	      )
	      (car list_ptlot)
      )
      (reverse
	(cdr
	  (VL-REMOVE-IF
	    'null
	    (mapcar
	      (FUNCTION
		(lambda	(i / l PT PT_0 PT_01 D DIST)
		  (if
		    (and (setq l (assoc "L" i))
			 (setq PT (assoc "PT" i))
			 (setq PT_0 (assoc "PT_0" i))
			 (setq D (assoc "D" i))
			 (setq l (apel-atof (cadr l)))
			 (setq PT_0 (cadr PT_0))
			 (setq PT (cadr PT))
			 (setq DIST
				(cond
				  (old_PT
				   (* 0.001
				      (distance	PT
						old_PT
				      )
				   )
				  )
				  (1.0)
				)
			 )
			 (setq DIST (list "DIST" (apel-rtos 2 DIST)))
			 (setq PT_01
				(list
				  "PT_01"
				  (cond
				    (old_PT_0
				     (list
				       (* 0.5 (+ (car PT_0) (car old_PT_0)))
				       (cadr PT_0)
				       (caddr PT_0)
				     )
				    )
				    ((list 0.0 0.0 0.0))
				  )
				)
			 )
			 (setq old_l l)
			 (setq old_PT PT)
			 (setq old_PT_0 PT_0)
		    )
		     (list dist D PT_01)
		  )
		)
	      )
	      (reverse list_blk_att)
	    )
	  )
	)
      )
    )
  )
;;;--------------------------------------
  (defun F16 (list_lot blk_obj / list_blk)
;;;  вставка промежуточных блоков с уклоном и расстоянием
;;;  арг: list_lot - список для вставки промежуточных блоков с уклоном и расстоянием
;;;       blk_obj - блок профиля
;;;  воз: список объектов блоков
    (mapcar
      (FUNCTION
	(lambda	(i / blk)
	  (if
	    (and (setq
		   blk (vla-InsertBlock
			 blk_obj
			 (APEL-POINT-LIST_TO_VARIANT
			   (cadr (assoc "PT_01" i))
			 )
			 "APEL_BLOCK_PROFIL_REPER3"
			 1
			 1
			 1
			 0
		       )
		 )
		 (setq list_blk (cons blk list_blk))
	    )
	     (APEL-BLOCK-PUT-ATTRIBUTES
	       blk
	       (list
		 (list "U" (cadr (assoc "U" i)))
		 (list "L" (cadr (assoc "DIST" i)))
		 (list "D" (strcat "%%C" (cadr (assoc "D" i))))
	       )
	     )
	  )
	)
      )
      list_lot
    )
    list_blk
  )
;;;--------------------------------------
  (defun F17 (list_blk_att blk_obj max_min / list_blk)
;;;  вставка блоков пересечений blk_2
;;;  арг:  list_blk_att - ассоциативный список
;;;  	   blk_obj - блок профиля
;;;        max_min - список макс и мин отм.
;;;  воз: список объектов блоков
    (vl-remove-if
      'null
      (mapcar
	(FUNCTION
	  (lambda (i / blk1 blk2 blk3 blk4 PT_0 PT_1 D Dx)
	    (if	(and (eq "R2" (cadr (assoc "TYPE" i)))
		     (setq
		       blk1 (vla-InsertBlock
			      blk_obj
			      (APEL-POINT-LIST_TO_VARIANT
				(setq PT_0 (cadr (assoc "PT_0" i)))
			      )
			      "APEL_BLOCK_PROFIL_REPER4_1"
			      1
			      1
			      1
			      0
			    )
		     )
		     (APEL-BLOCK-PUT-ATTRIBUTES
		       blk1
		       (list
			 (list "P" (cadr (assoc "P" i)))
			 (List "N" (cadr (assoc "N" i)))
		       )
		     )
		     (setq
		       blk2 (vla-InsertBlock
			      blk_obj
			      (APEL-POINT-LIST_TO_VARIANT
				(setq PT_1 (list
					     (car PT_0)
					     (setq dst_ot
						    (*
						      (/ 1000 *mv*)
						      (- (apel-atof
							   (cadr
							     (assoc "P_OT"
								    i
							     )
							   )
							 )
							 (cadr max_min)
						      )
						    )
					     )
					     (caddr PT_0)
					   )
				)
			      )
			      "APEL_BLOCK_PROFIL_REPER4_2"
			      1
			      1
			      1
			      0
			    )
		     )
		     (APEL-BLOCK-PUT-ATTRIBUTES
		       blk2
		       (if (eq 0.0 (setq D (APEL-ATOF (cadr (assoc "D" i)))))
			 (list (list "1" (cadr (assoc "P_OT" i)))
			       (list "2" "")
			 )
			 (list
			   (list "1" (strcat "%%C" (cadr (assoc "D" i))))
			   (list "2" (cadr (assoc "P_OT" i)))
			 )
		       )
		     )
		     (setq blk4
			    (vla-InsertBlock
			      blk_obj
			      (APEL-POINT-LIST_TO_VARIANT PT_1)
			      "APEL_BLOCK_PROFIL_REPER4_4"
			      (setq Dx (if (eq 0.0 D)
				0.1
				(* 0.001 D)
			      ))
			      (* Dx (/ *mg* *mv*))
			      1
			      0
			    )
		     )
		     (setq
		       blk3
			(vla-InsertBlock
			  blk_obj
			  (APEL-POINT-LIST_TO_VARIANT
			    (list
			      (car PT_0)
			      (setq dst
				     (1+ (cadr (cadr (apel-BoundingBox blk1))))
			      )
			      (caddr PT_0)
			    )
			  )
			  "APEL_BLOCK_PROFIL_REPER4_3"
			  1
			  (- dst_ot dst)
			  1
			  0
			)
		     )
		)
	      (list blk1 blk2 blk3 blk4)
	    )
	  )
	)
	list_blk_att
      )
    )
  )
;;;--------------------------------------
  (defun F18 (list_blk_att blk_obj max_min /)
;;;  вставка блоков обозначений blk_3
;;;  арг:  list_blk_att - ассоциативный список
;;;  	   blk_obj - блок профиля
;;;        max_min - список макс и мин отм.
;;;  воз: список объектов блоков
    (vl-remove-if
      'null
      (mapcar
	(FUNCTION
	  (lambda (i / obozn blk1 blk2 PT_0 dst)
	    (if	(and (eq "R3" (cadr (assoc "TYPE" i)))
		     (setq obozn (cadr (assoc "P" i)))
		     (not (member obozn (list  "" " " "  " "   " "    " "-" "--"))) ; не вставлять в таблицу, если нет обозначения
		     (setq
		       blk1 (vla-InsertBlock
			      blk_obj
			      (APEL-POINT-LIST_TO_VARIANT
				(setq PT_0 (cadr (assoc "PT_0" i)))
			      )
			      "APEL_BLOCK_PROFIL_REPER5_1"
			      1
			      1
			      1
			      0
			    )
		     )
		     (APEL-BLOCK-PUT-ATTRIBUTES
		       blk1
		       (list
			 (list "P" obozn)
			 (List "N" (cadr (assoc "N" i)))
		       )
		     )
		     (setq
		       blk2
			(vla-InsertBlock
			  blk_obj
			  (APEL-POINT-LIST_TO_VARIANT
			    (list
			      (car PT_0)
			      (setq dst
				     (1+ (cadr (cadr (apel-BoundingBox blk1))))
			      )
			      (caddr PT_0)
			    )
			  )
			  "APEL_BLOCK_PROFIL_REPER5_2"
			  1
			  (- (/
			       (*
				 1000
				 (- (apel-atof (cadr (assoc "Z" i)))
				    (cadr max_min)
				 )
			       )
			       *mv*
			     )
			     dst
			  )
			  1
			  0
			)
		     )
		)
	      (list blk1 blk2)
	    )
	  )
	)
	list_blk_att
      )
    )
  )
;;;--------------------------------------
  (defun F19 (list_blk_att blk_obj max_min /)
;;;  отрисовка колодцев
;;;  арг:  list_blk_att - ассоциативный список
;;;  	   blk_obj - блок профиля
;;;        max_min - список макс и мин отм.
;;;  воз: список объектов блоков колодцев
;;;    PT_0 - точка на верхней линии таблицы, для вставки блоков обозначений
;;;    PT_1 - точка проектной земли
;;;    PT_2 - точка лотка трубы
    
    (vl-remove-if
      'null
      (mapcar
	(FUNCTION
	  (lambda (i / blk1 blk2 blk3 PT_0 PT_1 PT_2 L Z L1)
	    (if	(and (eq "R1" (cadr (assoc "TYPE" i)))
		     (setq PT_0 (cadr (assoc "PT_0" i)))
		     (setq
		       PT_1
			(list
			  (car PT_0)
			  (/
			    (*
			      1000
			      (- (setq Z (apel-atof (cadr (assoc "Z" i)))); Получение отметки земли
				 (cadr max_min)
			      )
			    )
			    *mv*
			  )
			  (caddr PT_0)
			)
		     )
		     (setq L (apel-atof (cadr (assoc "L" i)))); Получение отметки лотка
		     (setq L1 (cond ((not (eq "" (setq L1 (cadr (assoc "L1" i))))) (apel-atof L1))) T T); Получение второй отметки лотка - если перепадной, если нет - то nil
		     (setq
		       PT_2
			(list
			  (car PT_0)
			  (/
			    (*
			      1000
			      (- (cond (L1 (min L L1))(L))
				 (cadr max_min)
			      )
			    )
			    *mv*
			  )
			  (caddr PT_0)
			)
		     )
		     ; Вставка люка колодца с обозначением глубины на профиль
		     (setq
		       blk1 (vla-InsertBlock
			      blk_obj
			      (APEL-POINT-LIST_TO_VARIANT
				PT_1
			      )
			      "APEL_BLOCK_PROFIL_REPER6_1"
			      1
			      1
			      1
			      0
			    )
		     )
		     ; Вставка основания колодца на профиль
		     (setq
		       blk2 (vla-InsertBlock
			      blk_obj
			      (APEL-POINT-LIST_TO_VARIANT
				PT_2
			      )
			      "APEL_BLOCK_PROFIL_REPER6_2"
			      1
			      1
			      1
			      0
			    )
		     )
		     ; Вставка блока колодца на профиль
		     (setq
		       blk3 (vla-InsertBlock
			      blk_obj
			      (APEL-POINT-LIST_TO_VARIANT
				PT_2
			      )
			      "APEL_BLOCK_PROFIL_REPER6_3"
			      1
			      (* (/ 1000 *mv*) (- Z (cond (L1 (min L L1))(L))))
			      1
			      0
			    )
		     )
		     (setq
		       blk4 (vla-InsertBlock
			      blk_obj
			      (APEL-POINT-LIST_TO_VARIANT PT_0)
			      "APEL_BLOCK_PROFIL_REPER6_4"
			      1
			      (cadr PT_1)
			      1
			      0
			    )
		     )
		     (APEL-BLOCK-PUT-ATTRIBUTES
		       blk1
		       (list
			 (list "h" (apel-rtos 2 (- Z (cond (L1 (min L L1))(L)))))
		       )
		     )
		)
	      (list blk1 blk2 blk3 blk4)
	    )
	  )
	)
	list_blk_att
      )
    )
  )
;;;--------------------------------------
  (defun F20 (list_blk_att blk_obj / PT_0_old PT_old)
;;;  Отрисовка расстояний по доп. точкам
;;;  арг:  list_blk_att - ассоциативный список
;;;  	   blk_obj - блок профиля
;;;  воз: список объектов блоков
    (vl-remove-if
      'null
      (mapcar
	(FUNCTION
	  (lambda (i / PT_0 PT PT_1 blk)
	    (if	(and (or
		       (eq "R1" (cadr (assoc "TYPE" i)))
		       (eq "R2" (cadr (assoc "TYPE" i)))
		       (and (eq "R3" (cadr (assoc "TYPE" i)))
			    (not (member (cadr (assoc "P" i)) (list  "" " " "  " "   " "    " "-" "--")))
		       )
		     )
		     (setq PT_0 (cadr (assoc "PT_0" i)))
		     (setq PT (cadr (assoc "PT" i)))
		)
	      (if (null PT_0_old)
		(setq PT_0_old PT_0
		      PT_old PT
		)
		(and (setq
		       PT_1 (cons (* 0.5 (+ (car PT_0) (car PT_0_old)))
				  (cdr PT_0)
			    )
		     )
		     (setq
		       DIST (apel-rtos 1 (* 0.001 (distance PT PT_old)))
		     )
		     (setq
		       blk (vla-InsertBlock
			     blk_obj
			     (APEL-POINT-LIST_TO_VARIANT
			       PT_1
			     )
			     "APEL_BLOCK_PROFIL_REPER7"
			     1
			     1
			     1
			     0
			   )
		     )
		     (APEL-BLOCK-PUT-ATTRIBUTES
		       blk
		       (list
			 (list "DIST"
			       DIST
			 )
		       )
		     )
		     (setq dist	(cond
				  ((>
				     (apply
				       '-
				       (reverse
					 (mapcar 'car
						 (APEL-BOUNDINGBOX blk)
					 )
				       )
				     )
				     (- (car PT_0) (car PT_0_old))
				   )
				   ""
				  )
				  (DIST)
				)
		     )
		     (APEL-BLOCK-PUT-ATTRIBUTES
		       blk
		       (list
			 (list "DIST"
			       DIST
			 )
		       )
		     )
		     (setq PT_0_old PT_0
			   PT_old PT
		     )
		)
	      )
	    )
	    blk
	  )
	)
	list_blk_att
      )
    )
  )
;;;--------------------------------------
  (defun F21 (blk_obj / base_point blk)
;;;  Вставка основного блока профиля
;;;  арг: blk_obj - блок профиля
;;;  воз: объект вставки
    (if	(and (setq base_point (GETPOINT "\n Точка вставки профиля:"))
	     (setq base_point (APEL-POINT-UCS_TO_WORLD base_point))
	)
      (setq blk	(APEL-BLOCK-INSERT
		  (APEL-MOD-GET_PROPERTY blk_obj 'Name)
		  (APEL-POINT-LIST_TO_VARIANT base_point)
		  (APEL-SCALE)
		  (APEL-SCALE)
		  (APEL-SCALE)
		  (APEL-ANGLE_UCS_WORLD 0)
		)
      )
    )
  )
;;;--------------------------------------
  (defun F22 (blk_obj list_pt blk_name / pt1)
;;;  Вспомогательная ф. по отрисовке отрезков из блоков с масштабированием по X
;;;  арг: blk_obj - пространство отрисовки
;;;  	  list_pt - список точек
;;;       blk_name - имя блока используемого для отрисовки
;;;  воз: список объектов вставок блока
    (setq pt1 (car list_pt))
    (mapcar (FUNCTION (lambda (i / a)
			(setq a	(vla-InsertBlock
				  blk_obj
				  (APEL-POINT-LIST_TO_VARIANT pt1)
				  blk_name
				  (distance pt1 i)
				  1
				  1
				  (angle pt1 i)
				)
			)
			(setq pt1 i)
			a
		      )
	    )
	    (cdr list_pt)
    )
  )
;;;--------------------------------------
;;;---встроенные ф.---
  (and (F1)		      ; Проверка наличия блоков в файле
       (setq list_blk_att (F2)) ; Получили список блоков
       (setq list_blk_att (F3 list_blk_att)) ; Ассоциативный список атрибутов блоков
       (F4 list_blk_att)      ;Проверка ассоциативного списка на параметр N порядковый номер
       (F5 list_blk_att)      ;Проверка ассоциативного списка на значения атрибутов блоков
       (setq list_blk_att (F6 list_blk_att)) ; добавление в ассоц. список расстояний между точками вставки блоков
       (setq list_blk_att (F7 list_blk_att)) ;Добавление в список точек вставок блоков для профиля
       (setq max_min (F8 list_blk_att)) ;Определение мин и мах отметок
       (setq list_ptlot (F9 max_min list_blk_att))
			      ;Получение точек плиний трубы
       (setq list_pls (F10 max_min list_blk_att)) ;Получение точек п.л. профилeй
       (setq blk_obj (F11))   ;  Создание блока профиля
       (setq list_pl_obj (F12 list_pls list_ptlot blk_obj)) ;Отрисовка полилиний по спискам list_pls и list_ptlot в блоке blk_obj
       (setq list_blk_0 (F13 max_min blk_obj list_pls)) ;Вставка блоков таблицы и елки отметок
       (setq list_blk_1 (F14 list_blk_att blk_obj)) ;вставка цифровых блоков по колодцам blk_1
       (setq list_blk_2 (F16 (F15 list_blk_att list_ptlot) blk_obj)) ;вставка промежуточных блоков с уклоном и расстоянием
       (cond ((setq list_blk_3 (F17 list_blk_att blk_obj max_min)))
	     (T)
       )		      ;вставка блоков пересечений blk_2
       (cond ((setq list_blk_4 (F18 list_blk_att blk_obj max_min)))
	     (T)
       )		      ;вставка блоков обозначений blk_3
       (setq list_blk_5 (F19 list_blk_att blk_obj max_min)) ;отрисовка колодцев
       (setq list_blk_6 (F20 list_blk_att blk_obj)) ;Отрисовка расстояний по доп. точкам
       (setq blk_obj_in (F21 blk_obj)) ;  Вставка основного блока профиля
       (princ "\n Все хорошо!")
  )
)

[veb86]

Сообщение от Apelsinov я видео делать не умею.

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

Сообщение от Apelsinov библиотечные функции - по ссылке у меня в подписи - я только что обновил там файл. Это FAS - там много функций, если заинтересует какая-то конкретно - я дам код.

ссылка не рабочая

[Apelsinov]

Сообщение от veb86 ссылка не рабочая

я добавил ссылку в предыдущее сообщение, видимо , та, что по подписи обновляется долго
видео тож.

[PsixVK]

Offtop: как бы не вышло рекламой
есть программа "проектвик" сайт uniservice что то там.
единственный минус не "Free" хотя и попробовать ее можно (кажись)

[jackUAROBEY]

Сообщение от Apelsinov Я не тестил твою программу, ибо мне не очень надо, мне кажется такая прога не очень универсальна и сильно труд не облегчит.

Как сказать 15 км напорного коллектора разбивает на пикеты за минуту. В ручную на это уйдет слегка побольше времени.

Сообщение от Apelsinov Мне не очень понравился код - слишком много переменных, и немного, на мой взгляд, коряво - хотя в целом впечатляет.

Это же любительская разработка. Конечно спецы все проще сделают.
У меня профиль то же есть. Пока нигде не вкладывал но если интересно запишу видосик. Его еще допиливать надо, да и все время что то добавляю. Нет пределу совершенства.
У меня потом инфа с мультивыносок на трассе на профиль уходит. Пропадает необходимость заполнять блоки в характерных точках.

[Apelsinov]

Сообщение от jackUAROBEY Как сказать 15 км напорного коллектора разбивает на пикеты за минуту. В ручную на это уйдет слегка побольше времени.

Я могу только за себя говорить, но я никогда не делал 15 километровый коллектор Вот еслиб программа различала диаметры, уклоны, нормативные расстояния и т.д, - тогда круть! Как это сделать? Я не знаю, пока, но все возможно...
Пока, при проектировании трассы порядка пары-тройки км, расстановка пикетов, выносок и даже нумерация узлов у меня занимает не значительную часть времени. Хотя какие-то идеи мне твоя программа подсказала

Сообщение от jackUAROBEY Это же любительская разработка. Конечно спецы все проще сделают.

Если делать более универсальные функции - меньше времени на кодинг впоследствии, например, создание блоков, выносок, обработчик ошибок с восстановлением переменных и т.д. Это же позволит делать дополнительные проверки и работу в нестандартных режимах. И ты совсем не используешь преимущества работы со списками через apply и mapcar.

Сообщение от jackUAROBEY У меня профиль то же есть. Пока нигде не вкладывал но если интересно запишу видосик

Конечно интересно, возможно, мы сможем помочь друг-другу.

Сообщение от jackUAROBEY У меня потом инфа с мультивыносок на трассе на профиль уходит. Пропадает необходимость заполнять блоки в характерных точках.

Да, это очень удобно. Но оформление и инфа вещи не всегда взаимозаменяемые.

[Do$]

Сообщение от Apelsinov Вот еслиб программа различала диаметры, уклоны, нормативные расстояния и т.д, - тогда круть! Как это сделать? Я не знаю, пока, но все возможно...

Как это сделать - так ведь задать эти параметры объектам. Тут уже много способов.
Мы разрабатываем приложение для проектирования сетей в Civil 3D. Так там есть каталог труб и колодцев. Каждой трубе в чертеже можно задать типоразмер из этого каталога. В каталоге содержатся параметры: внутренний, внешний диаметр, толщина стенки и т.д. Далее, труба в чертеже размещается в 3D пространстве, соответственно, по положению её концов можно вычислить уклон трубы.
Я не говорю, что нужно обязательно переходить на Civil 3D, но есть смысл познакомиться с другими приложениями для проектирования внешних сетей - их довольно много. Возможно, что проще будет купить готовое. Возможно, почерпнёте какие-то идеи и внесёте их в своё приложение.

[jackUAROBEY]

Сообщение от Apelsinov Конечно интересно, возможно, мы сможем помочь друг-другу.

У тебя что бы построить профиль надо сначала через уклоны высчитать отметки лотка. Мне этот головняк совсем не нравится. У меня прога сначала строит землю черную и красную, ставит пересечки и отметки земли. Потом рисую трубу как мне надо а потом прощелкиваю лоток а отметка автоматически ставится. Вся работа сводится к тупому щелканью и полностью исключается калькулятор. Уклоны то же пощелкал и они на месте. Можно сказать что построения профтля в полуавтоматическом режиме. Но уже думаю как сократить количество кликов мышкой.

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

Сообщение от Apelsinov преимущества работы со списками через apply и mapcar.

До этого я еще не дошел. Все никак не получается поподробней эти функции выучить. Раз в месяц если сяду програмировать то хорошо.

----- добавлено через ~38 мин. -----
Видос с профилем https://youtu.be/B_4k_c9l5-4

[Apelsinov]

Сообщение от jackUAROBEY У тебя что бы построить профиль надо сначала через уклоны высчитать отметки лотка. Мне этот головняк совсем не нравится.

я тоже сначала думал, что неудобно. Но хотелось, чтобы без ручного допиливания. Оказалось, что это работает и есть свои большие плюсы. У меня есть программка для расчета отметок по уклону
(apel-com '(apel-draw-pipe_height_mark)) - это удобно если нужен постоянный уклон. И есть для ливневки гидравлический расчет в эксель. Порой, при отрисовке профиля становится видно, что трасса не ложится на рельеф, тогда правлю отметки - это минус, но из-за быстроты отрисовки профиля я могу перерисовывать его сколько угодно.

Сообщение от jackUAROBEY Раз в месяц если сяду програмировать то хорошо.

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

[gomer]

Что за дурацкая манера пиарить свой код в ветках, где кто-то выкладывает пусть 100 раз несовершенные, но свои наработки? Это как минимум невежливо по отношению к автору.

[Apelsinov]

Offtop:

Сообщение от gomer Что за дурацкая манера пиарить свой код в ветках, где кто-то выкладывает пусть 100 раз несовершенные, но свои наработки? Это как минимум невежливо по отношению к автору.

Я не пиарюсь, ибо не продаю и не тешу амбиции. Если автор скажет - могу удалить все свои посты отсюда. Прохожие могут проходить.

[toss_vlg]

Приветствую, интересно было попробовать ваш лисп, но он у меня не работает, причем как то странно, я вижу на долю секунды что трасса замаркировалась и снова "голая" полилиния, хотя раняя версия вашего начинания(К1 В1 07.08.2016.LSP) немного криво(расстояния бывает указывает исходя из разных масштабов), но работает. Нужны специальные настройки для использования Trasser.LSP??

[jackUAROBEY]

Сообщение от toss_vlg Приветствую, интересно было попробовать ваш лисп, но он у меня не работает, причем как то странно, я вижу на долю секунды что трасса замаркировалась и снова "голая" полилиния, хотя раняя версия вашего начинания(К1 В1 07.08.2016.LSP) немного криво(расстояния бывает указывает исходя из разных масштабов), но работает. Нужны специальные настройки для использования Trasser.LSP??

https://apps.autodesk.com/ACD/ru/Det...ru&os=Win32_64

[toss_vlg]

Все тоже самое, справедливости ради нужно сказать что у меня ACAD 2010, видимо несовместимость...

[jackUAROBEY]

кинь файл ryzhkovdmitriyv@gmail.com