[VVS]

Вот такой лисп, хочется чтобы сумма длин выдавалась умноженная на определенный коэффициент, например, 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)
)

[Геннадий aka PG]

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

...
setq Sum (* 1.2 Sum (vlax-curve-getDistAtParam Curve
Param)))
)
)
)
)
)
(princ (strcat "\nСумма длин выбранных элементов равна: " (rtos Sum 2 2)))
(prin1)
) Измени цифирь на нужную.

[VVS]

Код изменил, первоначальный был моей поделкой и неработал вообщем.

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

Если с запросом, то можно попробовать так (не проверял):

Код:

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

(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)

[VVS]

Поражаюсь людям способным за 5 минут написать такое. А вот как-нибудь по-простому без запроса коэффициента можно?

[Pave1]

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

[Alaspher]

Без запроса (коэф. 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 спешка сказалась на работоспособности.

[VVS]

Огромное спасибо всем откликнувшимся.
Отдельно Alaspher!

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

> 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, да сделан вариант "отсутствия выбора".

[Pave1]

kpblc
класс!!
все работает.

[Лентяй]

Ну, и два цента от меня. все то же самое, но с возможностью ывбора множителя для каждой кривой.

Код:

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

(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

Может быть, немножко избыточно. но чем черт не шутит...