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

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

Нужен лисп, который высчитывает уклон линии

Ответ
Поиск в этой теме
Непрочитано 14.11.2005, 09:30 #1
Нужен лисп, который высчитывает уклон линии
ВоваН
 
Дороги, Конструкции, Тоннели
 
Сочи
Регистрация: 20.05.2004
Сообщений: 102

Нужен лисп, который высчитывает уклон линии.

Берем у выделенной линии Delta X, Delta Y и производим следующую операцию:

(Delta Y / Delta X)*1000

Результат выводим в командную строку.

Спасибо
Просмотров: 32401
 
Непрочитано 14.11.2005, 10:04
#2
Кулик Алексей aka kpblc
Moderator

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


Код:
[Выделить все]
(defun c:delta_line (/ ent result d_x d_y)
  (setq ent (ssget "_:S"))
  (if ent
    (progn
      (setq ent (entget (ssname ent 0)))
      (if (= (cdr (assoc 0 ent)) "LINE")
	(progn
	  (setq	d_x    (abs
			 (- (car (cdr (assoc 10 ent)))
			    (car (cdr (assoc 11 ent)))
			    ) ;_ end of -
			 ) ;_ end of abs
		d_y    (abs (- (cadr (cdr (assoc 10 ent)))
			       (cadr (cdr (assoc 11 ent)))
			       ) ;_ end of -
			    ) ;_ end of abs
		result (* (/ d_x d_y) 1000)
		) ;_ end of setq
	  (princ (strcat "\n" (rtos result 2 4)))
	  ) ;_ end of progn
	(princ "\nОбрабатываются только отрезки!")
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.11.2005, 11:41
#3
Эдуард

строительство
 
Регистрация: 16.01.2004
Петербург
Сообщений: 165
<phrase 1=


Или так
Код:
[Выделить все]
(defun C:uklon (/ lin)
  (if
    (and
      (setq lin (car (entsel)))
      (equal (cdr (assoc 0 (entget lin))) "LINE")
    )
     (*	1000
	(abs
	  (apply
	    '/
	    (cdr
	      (reverse
		(vlax-safearray->list
		  (vlax-variant-value
		    (vla-get-Delta (vlax-ename->vla-object lin))
		  )
		)
	      )
	    )
	  )
	)
     )
  )
)
Эдуард вне форума  
 
Автор темы   Непрочитано 14.11.2005, 15:19
#4
ВоваН

Дороги, Конструкции, Тоннели
 
Регистрация: 20.05.2004
Сочи
Сообщений: 102
<phrase 1=


Все получилось, только вместо:
result (* (/ d_x d_y) 1000)

нужно поставить:
result (* (/ d_y d_x) 1000)
ВоваН вне форума  
 
Непрочитано 14.11.2005, 21:41
#5
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Не люблю смешения французского с нижегородским. А посему - ловите чистый ActveX:
Код:
[Выделить все]
(defun C:Slope (/ dlt)
  (vla-getentity (vla-get-utility(vla-get-ActiveDocument (vlax-get-acad-object)))
    'ln (vlax-make-variant "\nSelect line: "))
  (setq dlt (vlax-get ln 'delta))
  (print (strcat "\nSlope: " (rtos (* (/ (cadr dlt) (car dlt)) 1000))))
);end
Пользуйтесь и не забывайте благодарить меня, любимого, за то, что я есть.
Лентяй вне форума  
 
Непрочитано 15.11.2005, 09:53
#6
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,186
<phrase 1=


Лентяй
Мне оч. понравилось уже. Но как отлавливать пустой выбор?
и почему-то строка запроса по умолчанию.

Код:
[Выделить все]
(defun C:Slope (/ dlt ln) 
  (vla-getentity (vla-get-utility(vla-get-ActiveDocument (vlax-get-acad-object))) 
    'ln (vlax-make-variant "\nSelect line: ")) 
  (setq dlt (vlax-get ln 'delta))
  (princ (strcat "\nSlope: " (rtos (* (/ (cadr dlt) (car dlt)) 1000))))
  (princ)
)
Apelsinov вне форума  
 
Непрочитано 15.11.2005, 10:58
#7
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Apelsinov: Но как отлавливать пустой выбор?
Сачком! В крайнем случае - неводом. Лентяй здесь - Я.
Цитата:
и почему-то строка запроса по умолчанию.
Эт вы об чем?
Лентяй вне форума  
 
Непрочитано 15.11.2005, 11:28
#8
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,186
<phrase 1=



Цитата:
Сачком! В крайнем случае - неводом. Лентяй здесь - Я.
Да ктож спорит! Но ты (именно с маленькой, дабы не смущать умы) наверняка знаешь как сделать этот сачок. А я не знаю. Я вообще такой способ выбора впервые вижу. Посему, ежели будет время - ответь ПОЖАЛУЙСТА.

Цитата:
Эт вы об чем?
О том, что у меня. например, идет запрос на выбор - "Select object:" а не "Select line:".
Apelsinov вне форума  
 
Непрочитано 15.11.2005, 11:56
#9
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Apelsinov: Но ты (именно с маленькой, дабы не смущать умы) наверняка знаешь как сделать этот сачок. А я не знаю. Я вообще такой способ выбора впервые вижу. Посему, ежели будет время - ответь ПОЖАЛУЙСТА.
Apelsinov, вот, как честный человек - не знаю. Знаю только, что vl-catch не катит.
Цитата:
О том, что у меня. например, идет запрос на выбор - "Select object:" а не "Select line:".
С этим просто. Добавить после 'ln неиспользуемый параметр 'pt
Код:
[Выделить все]
(vla-getentity (vla-get-utility(vla-get-ActiveDocument (vlax-get-acad-object))) 
    'ln 'pt (vlax-make-variant "\nSelect line: "))
Вообще-то это будет точка выбора, типа как в enеsel. Но тогда почему-то пояляется "правильный запрос". А вот если либо pt, либо (vlax-make-variant "\nSelect line: ") опустить, тогда будет запрос по умолчанию. Мистика-с.
Лентяй вне форума  
 
Непрочитано 15.11.2005, 12:17
#10
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,186
<phrase 1=


а еще можно:
Код:
[Выделить все]
(vla-getentity (vla-get-utility(vla-get-ActiveDocument (vlax-get-acad-object))) 'ln  pt  "Select line:")
Странно это...
Apelsinov вне форума  
 
Непрочитано 15.11.2005, 14:41
#11
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,186
<phrase 1=


Вот.
Код:
[Выделить все]
(defun C:Slope (/ dlt ln pt err_obj err_mes)
  (if (not
	(vl-catch-all-error-p
	  (setq	err_obj	(VL-CATCH-ALL-APPLY
			  (function
			    (lambda ()
			      (vla-getentity
				(vla-get-utility
				  (vla-get-ActiveDocument
				    (vlax-get-acad-object)
				  )
				)
				'ln
				'pt
				"Select line:"
			      )
			    )
			  )
			)
	  )
	)
      )
    (progn
      (if (vlax-property-available-p ln 'delta nil)
	(progn
	  (setq dlt (vlax-get ln 'delta))
	  (princ (strcat "\nSlope: "
			 (rtos (* (/ (cadr dlt) (car dlt)) 1000))
		 )
	  )
	)
	(setq err_mes "У этой хрени дельты нет!")
      )
    )
    (setq err_mes (VL-CATCH-ALL-ERROR-MESSAGE err_obj))
  )
  (if err_mes
    (princ err_mes)
  )
  (princ)
)
Apelsinov вне форума  
 
Непрочитано 15.11.2005, 18:28
#12
Tserber

ГИП + Главный Конструктор
 
Регистрация: 16.10.2005
город-герой Волгоград
Сообщений: 738


Я пользуюсь СПДС, и проблем таких не имею вообще [sm2103]
__________________
Нет - зарплате в конвертах, да - зарплате в бандеролях. :i-m_so_happy:
Tserber вне форума  
 
Непрочитано 15.11.2005, 21:32
#13
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


В заданной точке, на линиях, полилиниях, окружностях, эллисах, сплайнах, дугах, и х-линиях.
Код:
[Выделить все]
(defun c:klon(/ pt sset crv par der)
 (vl-load-com)
  (princ "\nУкажите точку на линии ")
  (and
    (setq pt(getpoint))
    (setq sset(ssget pt))
    (setq crv(ssname sset 0))
    (setq par(vlax-curve-getParamAtPoint crv pt))
    (setq der(vlax-curve-getFirstDeriv crv par))
    (princ(strcat "\nУклон = "
		  (rtos(* 1000(/(cadr der)(car der))))))
    ); end and
  (princ)
  ); end of c:klon
Нужно включить привязки.
{Smirnoff} вне форума  
 
Непрочитано 15.11.2005, 21:59
#14
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Что же вы, {Smirnoff}, забыли конвертировать примитив в обьект? Ай-ай-ай, а еще модератор...
Код:
[Выделить все]
(setq crv (vlax-ename->vla-object (ssname sset 0)))
Или так:
Код:
[Выделить все]
(setq crv (vla-item sset 0))
Лентяй вне форума  
 
Непрочитано 15.11.2005, 22:10
#15
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


>Лентяй
Вот что я забыл то это (vl-load-com). Изучайте матчасть...
{Smirnoff} вне форума  
 
Непрочитано 15.11.2005, 22:23
#16
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Хочу напомнить, что уклон: в геодезии, показатель крутизны склона; отношение превышения местности к горизонтальному протяжению, на котором оно наблюдается (напр., уклон, равный 0,015, соответствует подъему 15 м на 1000 м расстояния).
Это что у нас, как считают уклоны за бугром не знаю
fixo вне форума  
 
Непрочитано 16.11.2005, 11:33
#17
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


>Apelsinov Что-то у вас сачок сильно больше бабочки получился. Хотя пустая lambda - это круто.
Лентяй вне форума  
 
Непрочитано 16.11.2005, 11:48
#18
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,186
<phrase 1=


Лентяй
Ну было же
Цитата:
В крайнем случае - неводом
вот и получился невод...
зато ловит :wink:

А что большой, так это скорее закономерность. Пустой стакан.

Зы.
Обращение ко мне на "вы" (с маленькой) вызывает у меня раздвоение личности. на "Вы" - ощущение неравноправия, я ж тыкаю.
Apelsinov вне форума  
 
Непрочитано 17.11.2005, 19:31
#19
eax

проектирование транспортных сооружений
 
Регистрация: 26.04.2005
Москва
Сообщений: 107
<phrase 1=


давай электронку, вышлю прогу ... на Delphi
eax вне форума  
 
Непрочитано 11.03.2012, 23:26
#20
sinitsin1983


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


знатоки лиспа, и акада
а если нужен не просто уклон линии в точке,
а средний уклон 3д полилинии (например зигзагообразной канавы на склоне горы) усредненный по длинне ????
sinitsin1983 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен лисп, который высчитывает уклон линии

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

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