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

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

Помогите с небольшой доработкой лиспа

Ответ
Поиск в этой теме
Непрочитано 27.09.2005, 13:11 #1
Помогите с небольшой доработкой лиспа
VVS
 
проектирование автоматизированных систем управления и диспетчеризации на базе LonWorks
 
Санкт-Петербург
Регистрация: 24.01.2005
Сообщений: 16

Вот такой лисп, хочется чтобы сумма длин выдавалась умноженная на определенный коэффициент, например, 1.1 или 1.2. Заранее благодарен.

Код:
[Выделить все]
 
(defun C:Dlina (/ Nab Sum i Curve Param)
(vl-load-com)
(if (setq Nab (ssget))
(progn
(setq Sum 0 i 0)
(repeat (sslength Nab)
(setq Curve (vlax-ename->vla-object (ssname Nab i))

i (1+ i)
Param (vl-catch-all-apply 'vlax-curve-getEndParam
(list Curve))
)
(if (not (vl-catch-all-error-p Param))
(setq Sum (+ Sum (vlax-curve-getDistAtParam Curve
Param)))
)
)
)
)
)
(princ (strcat "\nСумма длин выбранных элементов равна: " (rtos Sum 2 2)))
(prin1)
)
Просмотров: 3098
 
Непрочитано 27.09.2005, 13:21
#2
Геннадий aka PG

Машиностроение, Проектирование
 
Регистрация: 15.09.2003
Москва
Сообщений: 1,113
<phrase 1=


Она ж и так на 1,2 умножается

...
setq Sum (* 1.2 Sum (vlax-curve-getDistAtParam Curve
Param)))
)
)
)
)
)
(princ (strcat "\nСумма длин выбранных элементов равна: " (rtos Sum 2 2)))
(prin1)
)
Измени цифирь на нужную.
__________________
С уважением,
Геннадий aka PG
Геннадий aka PG вне форума  
 
Автор темы   Непрочитано 27.09.2005, 13:26
#3
VVS

проектирование автоматизированных систем управления и диспетчеризации на базе LonWorks
 
Регистрация: 24.01.2005
Санкт-Петербург
Сообщений: 16


Код изменил, первоначальный был моей поделкой и неработал вообщем.
VVS вне форума  
 
Непрочитано 27.09.2005, 13:28
#4
Кулик Алексей aka kpblc
Moderator

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


Если с запросом, то можно попробовать так (не проверял):
Код:
[Выделить все]
(defun c:dlina (/ nab sum i curve param koeff)
  (vl-load-com)
  (if (setq nab (ssget))
    (progn
      (setq sum	0
	    i 0
	    koeff (getreal "\n Введите коэффициент умножения : ")
	    ) ;_ end of setq
      (if (or
	    (= koeff 0)
	    (not koeff)
	    )
	(setq koeff 1)
	)
      (repeat (sslength nab)
	(setq curve (vlax-ename->vla-object (ssname nab i))
	      i	    (1+ i)
	      param (vl-catch-all-apply
		      'vlax-curve-getendparam
		      (list curve)
		      ) ;_ end of vl-catch-all-apply
	      ) ;_ end of setq
	(if (not (vl-catch-all-error-p param))
	  (setq	sum (+ sum
		       (vlax-curve-getdistatparam
			 curve
			 param
			 ) ;_ end of vlax-curve-getDistAtParam
		       ) ;_ end of +
		) ;_ end of setq
	  (setq	sum (* koeff
		       sum
		       (vlax-curve-getdistatparam
			 curve
			 param
			 ) ;_ end of vlax-curve-getDistAtParam
		       ) ;_ end of *
		) ;_ end of setq
	  ) ;_ end of if
	) ;_ end of repeat
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
(princ (strcat "\nСумма длин выбранных элементов равна: " (rtos sum 2 2)))
(prin1)
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 27.09.2005, 13:35
#5
VVS

проектирование автоматизированных систем управления и диспетчеризации на базе LonWorks
 
Регистрация: 24.01.2005
Санкт-Петербург
Сообщений: 16


Поражаюсь людям способным за 5 минут написать такое. А вот как-нибудь по-простому без запроса коэффициента можно?
VVS вне форума  
 
Непрочитано 27.09.2005, 14:32
#6
Pave1

электроснабжение и автоматика
 
Регистрация: 21.06.2005
г. Пермь
Сообщений: 329


kpblc
запрос есть, но не работает. Сумма длин считается, но не умножается
__________________
хочу все знать
Pave1 вне форума  
 
Непрочитано 27.09.2005, 15:09
#7
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 755


Без запроса (коэф. 1.1):
Код:
[Выделить все]
(defun c:dlina (/ curve i koeff nab param sum)
  (vl-load-com)
  (if (setq nab (ssget))
    (progn
      (setq sum   0
            i     -1
;;;            koeff (getreal "\nВведите коэффициент умножения: ")
            koeff 1.1
      )
;;;      (if (or (= koeff 0) (not koeff))
;;;        (setq koeff 1)
;;;      )
      (while (setq curve (ssname nab (setq i (1+ i))))
        (setq curve (vlax-ename->vla-object curve))
        (if (not (vl-catch-all-error-p
                   (setq param (vl-catch-all-apply 'vlax-curve-getendparam (list curve)))
                 )
            )
          (setq sum (+ sum (vlax-curve-getdistatparam curve param)))
        )
      )
      (princ (strcat "\nСумма длин выбранных элементов равна: " (rtos (* koeff sum) 2 2)))
    ) ;_ end of progn 
  ) ;_ end of if
  (princ)
) ;_ end of defun
Немного отредактировал - в варианте kpblc спешка сказалась на работоспособности.
Alaspher вне форума  
 
Автор темы   Непрочитано 27.09.2005, 15:20
#8
VVS

проектирование автоматизированных систем управления и диспетчеризации на базе LonWorks
 
Регистрация: 24.01.2005
Санкт-Петербург
Сообщений: 16


Огромное спасибо всем откликнувшимся.
Отдельно Alaspher!
VVS вне форума  
 
Непрочитано 27.09.2005, 15:20
#9
Кулик Алексей aka kpblc
Moderator

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


> Pavel : ну я ж не проверял работоспособность исходного лиспа... Между прочим, там и в первый раз, и во второй - какие-то проблемы со скобками. Еще раз надо проверить. Сделал 2 варианта - с вызовом и без оного.
Код:
[Выделить все]
(defun calc-len	(koeff / nab result i curve param)
  (vl-load-com)
  (if (setq nab (ssget))
    (progn
      (setq result 0
	    i 0
	    ) ;_ end of setq
      (repeat (sslength nab)
	(setq curve (vlax-ename->vla-object (ssname nab i))
	      i	    (1+ i)
	      param (vl-catch-all-apply
		      'vlax-curve-getendparam
		      (list curve)
		      ) ;_ end of vl-catch-all-apply
	      ) ;_ end of setq
	(if (not (vl-catch-all-error-p param))
	  (setq	result (+ result
			  (vlax-curve-getdistatparam
			    curve
			    param
			    ) ;_ end of vlax-curve-getDistAtParam
			  ) ;_ end of +
		) ;_ end of setq
	  ) ;_ end of if
	) ;_ end of repeat
      (setq result (* result koeff))
      ) ;_ end of progn
    (setq result 0)
    ) ;_ end of if
  result
  ) ;_ end of defun

;; Функция с вводом данных
(defun c:len-req (/ koeff)
  (setq	koeff (getreal "\nВведите коэффициент <1> : ")
	) ;_ end of setq
  (if (or (= koeff 0) (= koeff nil))
    (setq koeff 1.0)
    ) ;_ end of if
  (princ (strcat
	   "\nСумма длин : "
	   (rtos (calc-len koeff) 2 2)
	   ) ;_ end of strcat
	 ) ;_ end of princ
  ) ;_ end of defun

;; Функция с коэффициентом по умолчанию
(defun c:len-def (/ koeff)
  (setq koeff 1.1)
  (princ (strcat
	   "\nСумма длин : "
	   (rtos (calc-len koeff) 2 2)
	   ) ;_ end of strcat
	 ) ;_ end of princ
  ) ;_ end of defun
Функция Calc-len - старая c:dlina с минимумом переделок. Там переименована sum в result, да сделан вариант "отсутствия выбора".
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 27.09.2005, 16:07
#10
Pave1

электроснабжение и автоматика
 
Регистрация: 21.06.2005
г. Пермь
Сообщений: 329


kpblc
класс!!
все работает.
__________________
хочу все знать
Pave1 вне форума  
 
Непрочитано 27.09.2005, 22:48
#11
Лентяй

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


Ну, и два цента от меня. все то же самое, но с возможностью ывбора множителя для каждой кривой.
Код:
[Выделить все]
(defun c:len-req (/ koeff curve dist result ) 
  (vl-load-com)
  (initget "Const Var")
  (setq result 0
        kw (getkword "\Коэффициент [Const/Var] ;? <Const>"))
  (if (null kw) (setq kw "Const"))
  (prompt "\nВыберите кривые) 
  (ssget)
  (if (= kw "Const")
    (setq koeff (getreal "\nВведите коэффициент <1> : "))
    (if (null koeff) (setq koeff 1.0)));const
  (vlax-for curve (vla-get-ActiveSelectionset (vla-get-ActiveDocument (vlax-get-acad-object)))
    (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list curve))))      
      (progn
        (setq dist (vlax-curve-getdistatparam curve (vlax-curve-getendparam curve)))
        (if (= kw "Var") (progn
                           (vla-highlight curve t)
                           (setq koeff (getreal "\nВведите коэффициент <1> : "))
                           (if (null koeff) (setq koeff 1.0))
                           (vla-update curve)));var
        (setq result (+ result (* koeff dist))));progn
    );if
  );vlax-for
  (princ (strcat "\nСумма длин : " (rtos result 2 2)))
);end
Может быть, немножко избыточно. но чем черт не шутит...
Лентяй вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Помогите с небольшой доработкой лиспа

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

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