[800x600]

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

Такой лисп я нашел в интернете, но он не работает. Пишет "Неверная точка. ; ошибка: Функция прервана.". (у меня ACAD 2011x64)
Ниже привожу код. Прошу подсказать где тут ошибка. Или может у кого, то есть альтернативный вариант


уклон сохраняется в глобальной переменной *RUNA_DDLSLOPE*, если задаете уклон с + то следущая точка будет выше предыдущей

Код:

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

;;;Построение линии по начальной точке и уклону заданому в промилях
(defun c:ddl (/ END_ELEV END_POINT SLOPE ST_ELEV ST_POINT)
;|
; Global variables: (*RUNA_DDLSLOPE*)
|;
  (if (not *runa_ddlslope*) (setq *runa_ddlslope* 5))
(setq slope (GETREAL
          (STRCAT "Specify slope in promille or <"
             (rtos *runa_ddlslope* 2) " ?>: ")))
  (if (null slope)
    (setq slope *runa_ddlslope*)
    (setq *runa_ddlslope* slope))
  (setq st_point (getpoint "DDL Specify first point: "))
  (if (null st_point)
    (setq st_point (GETVAR "LASTPOINT")))
  (setq st_elev (last st_point))
  (setq st_elev (GETREAL
          (STRCAT "\nStart elevation <"
             (rtos st_elev 2) ">: ")))
  (if (null st_elev)
    (setq st_elev (last st_point)))
  (setq end_point (getpoint st_point "Specify end point of line: "))
  (if (null end_point)
    (princ "Cannot build a zero length line.")
    (progn
      (setq end_elev
        (+ st_elev
      (* slope 0.001
      (setq dist_in_plane
      (distance
      (cdr (reverse st_point))
      (cdr (reverse end_point)))))))
      (command "_.line"
          ".xy"
          "none"
          st_point
          st_elev
          ".xy"
          "none"
          end_point
          end_elev
          "")
      (princ (STRCAT "\nEnd elevation: "
           (rtos end_elev 2)
           "   Distance in plane: "
           (rtos dist_in_plane 2)))
      );progn
    );if
  (princ)
); end defun

[gomer]

Сообщение от 800x600 Неверная точка. ; ошибка: Функция прервана.

Вероятно не указана точка, поэтому программа не знает что ей делать и завершается

[Puroshev]

Код:

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

 
 ;*************************************************************************
 ; Преобразование отрезков с уклоном
 ; Donetsk
 ; Puroshev S.  
; e-Mail:  [email protected] 
 ;*************************************************************************
(defun C:PSW  (/ DIS I N OLDOSMODE PROM SS T1 T2 Z)
    (setvar "CMDECHO" 0)
    (setq OldOsMode (GetVAR "OsMode"))
    (setVar "OsMode" 0)
 ;----------------------------------------------------------------------------
    		 (prompt "\nВыберите oтрезки: ")
    (setq SS NIL)
    (setq SS (ssget))
    (setq N (sslength SS))
    (setq i 0)
  (setq Prom (Getreal "\nУклон в процентах: "))
;****************************************************************** 
    (repeat N
	(if (=  (cdr (assoc 0 (entget (ssname ss i)))) "LINE")
	    (progn
		(setq T1 (cdr (assoc 10 (entget (ssname ss i)))))
		(setq T2 (cdr (assoc 11 (entget (ssname ss i)))))
	        (setq Dis (distance T1 T2))
	        (setq Z (* (/ prom 100.0) Dis))
	        (setq T2 (list (car T2) (cadr T2) (+ (caddr T2) Z)))
		(entdel (ssname ss i))
		(command "_LINE" T1 T2 "")
		)
	    ) ;if "Line"
      	(setq I (+ 1 I))
      ); Repeat
 ;*******************************************************
    (setVar "OsMode" OldOsMode)
 (princ)
    )

[800x600]

gomer

Сообщение от gomer Вероятно не указана точка, поэтому программа не знает что ей делать и завершается

на запрос программы "Specify end point of line:" я кликом показываю место где должна располагаться вторая точка отрезка и тут же получаю "Неверная точка.; ошибка: Функция прервана."

Puroshev
ваш лисп наклоняет существующие отрезки, а в моем случае нужно чертить их заново.

[Puroshev]

Код:

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

 
 ;*************************************************************************
 ; Рисование отрезков с уклоном 
 ; Donetsk
 ; Puroshev S.  [email protected]  
; (если нужна доработка и пожелания пиши)
 ;*************************************************************************
(defun C:PSW  (/ DIS I N OLDOSMODE PROM SS T1 T2 Z)
    (setvar "CMDECHO" 0)
    (setq OldOsMode (GetVAR "OsMode"))
    (setVar "OsMode" 0)
  (setq Prom (Getreal "\nУклон в процентах: "))
  (setq T1 (GetPoint "\nПервая точка: "))
  (setq T2 (GetPoint T1 "\nВторая точка: "))
;****************************************************************** 
    	        (setq Dis (distance T1 T2))
	        (setq Z (* (/ prom 100.0) Dis))
	        (setq T2 (list (car T2) (cadr T2) (+ (caddr T2) Z)))
		(command "_LINE" T1 T2 "")
 ;*******************************************************
    (setVar "OsMode" OldOsMode)
 (princ)
    )

[800x600]

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

-Необходимо чертить серию отрезков. Всегда первая точка любого следующего отрезка должна совпадать с конечной точкой предыдущего отрезка.
Координаты начальной точки (первой точки первого отрезка) по XY указываем кликом мыши, а по Z через запрос в командной строке. Т.е. начале команды кроме запроса "Уклон в процентах:" добавится еще запрос "Начальный уровень:"

[Puroshev]

Код:

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

  ;*************************************************************************
 ; Рисование отрезков с уклоном 
 ; Donetsk
 ; Puroshev S.  
 ; (если нужна доработка и пожелания пиши [email protected])
 ; а можно узнать для какой задачи это нужно ????
 ;*************************************************************************
(defun C:PSW  (/ DIS T1 T2 Z)
  (setvar "CMDECHO" 0)
  (setq Prom (Getreal "\nУклон в процентах: "))
  (setq Urov (Getreal "\nНачальный уровень: "))
  (setq T1 (GetPoint "\nПервая точка: "))
  (setq T1 (list (car T1) (cadr T1) Urov))
  (command "_LINE" T1)
      (While (/= T1 nil)
	  (setq T2 (GetPoint T1 "\nСледующая точка: "))
	  (if (/= T2 nil)
	    (progn  
	  		(setq T2 (list (car T2) (cadr T2) (caddr T1)))
	    	        (setq Dis (distance T1 T2))
		        (setq Z (* (/ prom 100.0) Dis))
		        (setq T2 (list (car T2) (cadr T2) (+ (caddr T2) Z)))
			(command T2)
	    ))
	    (setq T1 T2)
      )
 (princ)
    )

[gomer]

Сообщение от 800x600 на запрос программы "Specify end point of line:" я кликом показываю место где должна располагаться вторая точка отрезка и тут же получаю "Неверная точка.; ошибка: Функция прервана."

Замени "none" на "_none" и программа заработает

[800x600]

Сообщение от Puroshev а можно узнать для какой задачи это нужно ????

Объясню на примере. Есть начерченный в 2D (плоский) план сети канализации этажа Рис1. На нем указаны отметки уровня для трубы в разных точках. Эти отметки рассчитаны вручную и очень часто с ошибками.
Идея в следующем- обвести (используя привязку) существующий двухмерный план указав уклон и построить в 3D схему сети для проверки высотных отметок. Это показано на Рис 2.
Понятно, что для этих целей есть специализированное ПО, но в распоряжении только голый Автокад.

Рис.1


Рис.2

[Profan]

Сообщение от 800x600 Включаем вид сверху и чертим (в плане) серию отрезков/полилиний

Слово "полилиний" здесь недопустимо.

[nolte]

все что есть на этаже сливается в вертикальную трубу(а их на этаже 1 или несколько штук) т.е. уклон начинается именно с этой точки. вот оттуда надо и начинать уклон (вверх) для всех труб, включая привязанные к трубам дела типа сифонов, подъемов труб по стене к умывальнику и пр., короче следует учесть все что есть по цепочке от точки соединения системы канализации к вертикали до самой дальней и последней точке. так что лисп с поста 3 самое то, осталось учесть только мелочи.

[800x600]

Проблема лиспа из 7 поста в работе с привязками. А именно невозможно обвести двухмерную схему. При включении 2D привязки отрезки строятся без требуемого смещения по Z

Сообщение от nolte все что есть на этаже сливается в вертикальную трубу(а их на этаже 1 или несколько штук) т.е. уклон начинается именно с этой точки. вот оттуда надо и начинать уклон (вверх) для всех труб

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

Сообщение от nolte так что лисп с поста 3 самое то, осталось учесть только мелочи.

Не согласен. Лисп из 3-его поста наклоняет существующие отрезки, а это не удобно. Во-первых, не угадаешь в какую сторону он наклонится.
Для иллюстрации- нарисуйте два параллельных отрезка один с лева направо, а другой с права на лево и оба наклоните. Уклон естественно будет в разные стороны.
Во-вторых, после задания уклона всей сети необходимо будет руками сдвигать отрезки по вертикали, т.к. по Z отрезки не будут совпадать.
Гораздо удобнее моя схема работы (она лишена описанных выше недостатков) Когда мы вводим А) уклон Б) начальную отметку уровня по Z, далее включаем 2D-привязку и обводим на плане существую плоскую систему из труб. В итоге получаем корректную трехмерную схему. В свойствах отрезков (в координате Z) мы увидим искомые высотные отметки. Так что лисп из 7 поста гораздо ближе к идеалу.

Сообщение от Profan Слово "полилиний" здесь недопустимо.

видимо точнее было бы написать "3D-полилинию" но и отрезки меня полностью устраивают

Сообщение от gomer Замени "none" на "_none" и программа заработает

да, то лисп заработал. Спасибо за подсказку. я его проверил, оказалось он чертит отрезки не сериями а по одному

[nolte]

далее включаем 2D-привязку и обводим на плане существую плоскую систему из труб

зачем перечерчивать уже начерченное?

Лисп из 3-его поста наклоняет существующие отрезки, а это не удобно. Во-первых, не угадаешь в какую сторону он наклонится.

это лечиться с помощью функции vlax-curve-getClosestPointTo

Во-вторых, после задания уклона всей сети необходимо будет руками сдвигать отрезки по вертикали, т.к. по Z отрезки не будут совпадать.

начало следующего отрезка заменить Z на Z конца предыдущего отрезка и от него уже брать уклон.
и в этом случае все сводиться к одному клику на каждом отрезке.
я думаю, что возможно свести все к одному клику для всей системы(если она выходит из одной вертикальной трубы).
это все верно для случая если система начерчена отрезками, если полилинией, то придеться ее менять на отрезки или 3Dполилинию.

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

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

800x600, вашу за ногу! Ну неужели картинки в пост не приложить? Ведь не видно ни фига!

[800x600]

Сообщение от nolte я думаю, что возможно свести все к одному клику для всей системы

это было бы здорово, но думаю, что лисп с повторным черчением гораздо проще. К примеру, чтобы реализовать Т-образное пересечение двух отрезков, нужно будет вычислять Z точки примыкающего отрезка. Одно лишь это сильно усложнит задачу

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

Сообщение от Кулик Алексей aka kpblc 800x600, вашу за ногу! Ну неужели картинки в пост не приложить? Ведь не видно ни фига!

я приложил две картинки (Рис1. и Рис2.) в пост 9

[Puroshev]

800х600 Исправил баг с привязкой, протестируй

Код:

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

   ;*************************************************************************
 ; Рисование отрезков с уклоном 
 ; Donetsk
 ; Puroshev S.  
 ; (если нужна доработка и пожелания пиши [email protected])
 ; а можно узнать для какой задачи это нужно ????
 ;*************************************************************************
(defun C:PSW  (/ DIS T1 T2 Z)
  (setvar "CMDECHO" 0)
      (setq OldOsMode (GetVAR "OsMode"))
  (setq Prom (Getreal "\nУклон в процентах: "))
  (setq Urov (Getreal "\nНачальный уровень: "))
  (setq T1 (GetPoint "\nПервая точка: "))
  (setq T1 (list (car T1) (cadr T1) Urov))
  (command "_3dpoly" T1)
      (While (/= T1 nil)
	  (setq T2 (GetPoint T1 "\nСледующая точка: "))
	  (if (/= T2 nil)
	    (progn  
	  		(setq T2 (list (car T2) (cadr T2) (caddr T1)))
	    	        (setq Dis (distance T1 T2))
		        (setq Z (* (/ prom 100.0) Dis))
		        (setq T2 (list (car T2) (cadr T2) (+ (caddr T2) Z)))
	          	(setVar "OsMode" 0)
			(command T2)
	          (setVar "OsMode" OldOsMode)
	    ))
	    (setq T1 T2)
      )
 (princ)
    )

[800x600]

Сообщение от Puroshev 800х600 Исправил баг с привязкой, протестируй

протестировал. Сейчас когда чертишь с привязкой у самой первой точки Z сбрасывается в 0. Т.е. "Начальный уровень" не применяется

[Puroshev]

Для 800х600. Ну еще раз. Сижу в гостях без автокада. Не могу тестировать.

Код:

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

   ;*************************************************************************
 ; Рисование 3Dpoly с уклоном 
 ; Donetsk
 ; Puroshev S.  
 ; (если нужна доработка и пожелания пиши [email protected])
 ; а можно узнать для какой задачи это нужно ????
 ;*************************************************************************
(defun C:PSW  (/ DIS T1 T2 Z)
  (setvar "CMDECHO" 0)
      (setq OldOsMode (GetVAR "OsMode"))
  (setq Prom (Getreal "\nУклон в процентах: "))
  (setq Urov (Getreal "\nНачальный уровень: "))
  (setq T1 (GetPoint "\nПервая точка: "))
  (setq T1 (list (car T1) (cadr T1) Urov))
  (setVar "OsMode" 0)
  (command "_3dpoly" T1)
  (setVar "OsMode" OldOsMode)
      (While (/= T1 nil)
	  (setq T2 (GetPoint T1 "\nСледующая точка: "))
	  (if (/= T2 nil)
	    (progn  
	  		(setq T2 (list (car T2) (cadr T2) (caddr T1)))
	    	        (setq Dis (distance T1 T2))
		        (setq Z (* (/ prom 100.0) Dis))
		        (setq T2 (list (car T2) (cadr T2) (+ (caddr T2) Z)))
	          	(setVar "OsMode" 0)
			(command T2)
	          (setVar "OsMode" OldOsMode)
	    ))
	    (setq T1 T2)
      )
 (princ)
    )

[nolte]

К примеру, чтобы реализовать Т-образное пересечение двух отрезков, нужно будет вычислять Z точки примыкающего отрезка. Одно лишь это сильно усложнит задачу

вот для этого и надо скромное вознаграждение. ну соответственно и для других подводных камней.

а Ваш, на мой взгляд, не совсем эффективный метод решается примерно так(слегка поправил предложенный лисп)

Код:

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

 
(defun C:PSW  (/ obj qt urov)
(vl-load-com)
(setq OldOsMode (GetVAR "OsMode"))
(setq Prom (Getreal "\nУклон в процентах: "))
(while(not(eq qt "q"))
	(vl-cmdf "_LINE"(getpoint "\nПервая точка: ")(GetPoint "\nСледующая точка: ") "")
	(setq obj(vlax-ename->vla-object(entlast)))
	(if(not urov)(setq urov(last(getpoint "\nНачальный уровень :"))))
	(setVar "OsMode" 0)
	(vla-put-startpoint obj
		(vlax-3d-point(subst urov (last(vlax-curve-getstartpoint obj))(vlax-curve-getstartpoint obj)))
	)
	(vla-put-endpoint obj
		(vlax-3d-point
			(subst
				(- urov(* 0.01 (vla-get-length obj) prom))
				(last(vlax-curve-getendpoint obj))
				(vlax-curve-getendpoint obj)
			)
		)
	)
	(setVar "OsMode" OldOsMode)
	(setq urov(last(vlax-curve-getendpoint obj)))
	(setq qt(getstring "\nEXIT - <q> :"))
)
(vlax-release-object obj)
(princ)
)

[800x600]

Puroshev
Протестировал последний лисп. Вот это именно то что требовалось, работает так как надо! Огромная благодарность за помощь!

Сообщение от nolte на мой взгляд, не совсем эффективный метод решается примерно так(слегка поправил предложенный лисп)

Так тоже можно подойти к решению, но вариант с 3D-полилинией (пост 18) мне показался более удобным.



Кстати немного доработал технологию. Для наглядности чтобы видеть отметки уровней по Z в виде текстов на каждом повороте 3D полилинии (как на Рисунке 1, Пост 9 ) С помощью ниже приведенного лиспа можно добавить такие отметки. Только предварительно нужно (к сожалению руками) используя 3D привязку расставить точки.

Код:

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

 (defun c:otm ( / *mspace* adoc ent_sad h)

(setq adoc (vla-get-activedocument (vlax-get-acad-object))

      *mspace* (vla-get-ModelSpace adoc))

(setq h (getreal "\nЗадайте высоту текста: "))

(setq ent_sad (entnext))

(while ent_sad

 (if (= (cdr (assoc 0 (entget ent_sad))) "POINT")

   (vla-AddText *mspace* (rtos (cadddr (assoc 10 (entget ent_sad))) 2 2) (vlax-3d-point (cdr (assoc 10 (entget ent_sad)))) h)

 );end if

(setq ent_sad (entnext ent_sad)); счетчик для условия выхода...

);end while

);defun