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

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

Нужен LISP для суммы длин отрезков линни

Ответ
Поиск в этой теме
Непрочитано 26.02.2004, 10:13
Нужен LISP для суммы длин отрезков линни
ilka_t
 
Москва
Регистрация: 20.01.2004
Сообщений: 154

Подскажити где можно скачать или поделитись если у кого есть такое.

Полилиния не подходит т.к. эти отрезки разбросаны по всему чертежу, а надобы выбрав несколько линий узнать их общую длинну.
Просмотров: 134692
 
Непрочитано 17.05.2007, 15:25
#61
novichok7


 
Регистрация: 19.04.2007
WWW.OTTUDA.RU
Сообщений: 3


Цитата:
Сообщение от {Smirnoff}
По поручению kos. Его вариант лиспа с предварительным выбором:
Здравствуйте!
А как дописать код, чтобы итоговая сумма не только выводилась на экран, но и кидалась в буфер обмена. Спасибо.
novichok7 вне форума  
 
Непрочитано 17.05.2007, 17:36
#62
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>novichok7
Отредактированный вариант
Код:
[Выделить все]
(vl-load-com)
(if (null *MIP-MODEMACRO-HTXT*)(setq *MIP-MODEMACRO-HTXT* 3.0)) ;_Высота текста
(if (null *MIP-MODEMACRO-RTOS*)(setq *MIP-MODEMACRO-RTOS* -1.0));_Округление -1-LUPREC
(if (null *MIP-MODEMACRO-SCALE*)(setq *MIP-MODEMACRO-SCALE* 1)) ;_Масштаб
(VL-PROPAGATE '*MIP-MODEMACRO-HTXT*)
(VL-PROPAGATE '*MIP-MODEMACRO-RTOS*)
(VL-PROPAGATE '*MIP-MODEMACRO-SCALE*)
(defun C:entLen (/ set:entities      int:allEntities 
            int:curveEntities int:l         rea:length 
         )
  (princ "\nТекущий коэффициент K=")(princ (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*))
  (if (not (setq set:entities (cadr (ssgetfirst))))    ; Этот if добавлен для 
    (setq set:entities (ssget))            ; обработки предварительного 
  ) ;_ if                  ; выбора примитивов 
  (if set:entities 
    (progn 
      (setq int:allEntities 
        (sslength set:entities)   ; количество выбранных примитивов 
       int:curveEntities 
        0            ; счетчик линейных примитивов 
       int:l 0         ; счетчик 
       rea:length 
        0.0         ; общая длина линейных примитивов 
      ) ;_  setq 
      (while (< int:l (sslength set:entities)) 
   (if 
     (not 
       (vl-catch-all-error-p 
         (vl-catch-all-apply 
      'vlax-curve-getStartPoint 
      (list 
        (vlax-ename->vla-object (ssname set:entities int:l)) 
      ) ;_ list 
         ) ;_  vl-catch-all-apply 
       ) ;_  vl-catch-all-error-p 
     ) ;_  not 
      (setq int:curveEntities (1+ int:curveEntities) 
       rea:length      (+ rea:length 
                  (vlax-curve-getDistAtParam 
               (vlax-ename->vla-object 
                 (ssname set:entities int:l) 
               ) ;_ vlax-ename->vla-object 
               (vlax-curve-getEndParam 
                 (ssname set:entities int:l) 
               ) ;_ vlax-curve-getEndParam 
                  ) ;_  vlax-curve-getDistAtParam 
               ) ;_  + 
      ) ;_  setq 
   ) ;_  if 
   (setq int:l (1+ int:l)) 
      ) ;_  while
      (setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length))
      (princ (strcat "\n Выбрано примитивов: " 
           (itoa int:allEntities) 
           ", из них линейных: " 
           (itoa int:curveEntities)
           "\nПоправочный коэфиициент K="                     
           "\n Общая длина линейных примитивов: "
        (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))                     
        ) ;_ strcat 
      ) ;_ princ 
    ) ;_  progn 
    (alert "Примитивы не выбраны!") 
  ) ;_  if 
  (prin1) 
) ;_  defun

(defun c:MM ( / buf )
  (initget 7)
  (setq *MIP-MODEMACRO-SCALE* (getreal "\nНовый масштабный коэффициент: "))
  (initget 6)
  (princ "\nВысота текста <")(princ *MIP-MODEMACRO-HTXT*)(princ ">: ") 
  (if (setq buf (getdist))(setq *MIP-MODEMACRO-HTXT* buf))
  (initget 4 "L")
  (princ "\nТочность округления [Luprec] <")
  (if (< *MIP-MODEMACRO-RTOS* 0)(princ "Luprec")(princ *MIP-MODEMACRO-RTOS*))
  (princ ">: ") 
  (if (setq buf (getint))(setq *MIP-MODEMACRO-RTOS* (if (numberp buf) buf -1)))
  (VL-PROPAGATE '*MIP-MODEMACRO-HTXT*)
  (VL-PROPAGATE '*MIP-MODEMACRO-RTOS*)
  (VL-PROPAGATE '*MIP-MODEMACRO-SCALE*)
  (princ)
  )
(defun c:LP ( )(if (= (type *MIP-LENGTH*) 'REAL)(progn
(vla-addtext(vla-get-block(vla-get-ActiveLayout(vla-get-ActiveDocument(vlax-get-acad-object))))
(rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))  
(vlax-3d-point '(0 0 0)) *MIP-MODEMACRO-HTXT*)(princ "\n Укажите точку вставки текста:")
(command "_.copybase" '(0 0 0) (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause)))
(princ))
Определены 3 команды
EntLEN - суммирует длинны выбранных объектов с учетом поправочного коэффициента
MM - устанавливает параметры:
- поправочный коэфициент
- точность округления
- высоту текста
LP - печатает разультат. Сам результат хранится в глобальной переменной *MIP-LENGTH*. Можно посмотреть, набрав !*MIP-LENGTH* в командной строке

*** Добавлено 28.04.2008
Версия команды LP с разделителем запятой
Код:
[Выделить все]
(defun c:LP ( )(if (= (type *MIP-LENGTH*) 'REAL)(progn
(vla-addtext(vla-get-block(vla-get-ActiveLayout(vla-get-ActiveDocument(vlax-get-acad-object))))
(vl-string-translate "." ","  
(rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))
  )
(vlax-3d-point '(0 0 0)) *MIP-MODEMACRO-HTXT*)(princ "\n Укажите точку вставки текста:")
(command "_.copybase" '(0 0 0) (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause)))
(princ))
*** Добавлено 07.11.2012
Вариант с реакторами

Последний раз редактировалось VVA, 10.09.2017 в 12:16. Причина: Вариант с реакторами
VVA вне форума  
 
Непрочитано 21.05.2007, 15:05
#63
novichok7


 
Регистрация: 19.04.2007
WWW.OTTUDA.RU
Сообщений: 3


Спасибо.
Одно только уточнение.
А как мне сделать, чтобы значение из переменной MIP-LENGTH попало в буфер обмена Windows. Суть - я потом в Excel эти значения копирую и считаю. Т.е. сейчас мышью или клавиатурой выделяю полученное значение, потом Ctrl+C, перехожу в Excel, Ctrl+V.
novichok7 вне форума  
 
Непрочитано 29.05.2007, 12:41
#64
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,895


[quote=novichok7]
Цитата:
Сообщение от "VVA
Спасибо.
Одно только уточнение.
А как мне сделать, чтобы значение из переменной MIP-LENGTH попало в буфер обмена Windows. Суть - я потом в Excel эти значения копирую и считаю. Т.е. сейчас мышью или клавиатурой выделяю полученное значение, потом Ctrl+C, перехожу в Excel, Ctrl+V.

У меня попало
Сделал так:
Качаешь DOSLib вот от сюда:
http://www.en.na.mcneel.com/doslib.htm
Устанавливаешь, и в итоге у тебя появится "c:\Program Files\DOSLib 7.5\DOSLib17.arx"
Этот DOSLib17.arx кидаешь в автозагрузку, а в коде из поста 62, после строчки
Код:
[Выделить все]
(setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length))
добавишь эту:
Код:
[Выделить все]
(if dos_clipboard (dos_clipboard (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))))
Krieger вне форума  
 
Непрочитано 14.06.2007, 08:31
#65
novichok7


 
Регистрация: 19.04.2007
WWW.OTTUDA.RU
Сообщений: 3


Спасибо. Все заработало!!!
novichok7 вне форума  
 
Непрочитано 14.06.2007, 15:43
#66
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,138


Цитата:
Сообщение от {Smirnoff}
Ну что еще попробуем? Все что было до этого к сожалениию не позволяло предварительно выбрать нужные примитивы с помощью QSelect, Filter, (ssx) да и просто выбрать примитивы а потом уже запустить лисп.
Код:
[Выделить все]
(defun c:elen(/ fList firSet entSet filOut entList totLen)
  (vl-load-com)
  (setq fList '((-4 . "<OR")(0 . "*LINE")
		(0 . "CIRCLE")(0 . "ARC")
		(0 . "ELLIPSE")(-4 . "OR>")
		(-4 . "<NOT")(0 . "MLINE")
		(-4 . "NOT>"))
	filOut 0
	); end setq
  (if
    (not
      (and
	(setq firSet(ssget "_I")
	      entSet(ssget "_I" fList)
	      ); end setq
	); end and
      ); end not
    (setq entSet(ssget fList))
    (setq filOut(-(sslength firSet)(sslength entset)))
    ); end if
  (if entSet
    (progn
      (setq entList
	   (mapcar 'vlax-ename->vla-object 
                    (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex entSet))))
	    totLen
	     (apply '+
		    (mapcar '(lambda (x)
			       (vlax-curve-getDistAtParam x
				 (vlax-curve-getEndParam x)))
			    entList); end mapcar
		    ); end apply
	    ); end setq
      (if(/= 0 filOut)
	(princ(strcat "\n" (itoa filout)
		      " were filtered out (unsupported type)"))
	); end if
      (princ(strcat "\nTotal entities: "(itoa(length entList))
		    " Total length: "(rtos totLen)); end strcat
	    ); end princ
      ); end progn
    (progn
        (if(/= 0 filOut)
	(princ(strcat "\n" (itoa filout)
		      " were filtered out (unsupported type)"))
	(princ "\nNothing selected")
	); end if
    ); end progn
    ); end if
      (princ)
      ); end c:elen
Наш штатный психоаналитик не зря закрепил эту тему. Кто следующий :?: 8)
А нельзя ли сделать чтобы исходный ответ т.е. длина в метрах выводилась не так (1893792), а вот так (1893.792 метрофф) :roll: :idea:
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 14.06.2007, 16:03
#67
Zouss


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


попробовать
Код:
[Выделить все]
          " Total length: "(rtos totLen)); end strcat
отредактировать следующим образом
Код:
[Выделить все]
          " Total length: "(rtos (/ totLen 1000))); end strcat
Zouss вне форума  
 
Непрочитано 14.06.2007, 16:52
#68
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>dextron3
Возьми код с поста №62. До ввода команды EntLen, введи MM, укажи масштабный коэффициент 0.001
VVA вне форума  
 
Непрочитано 14.06.2007, 22:04
#69
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,138


Цитата:
Сообщение от Zouss
попробовать
Код:
[Выделить все]
          " Total length: "(rtos totLen)); end strcat
отредактировать следующим образом
Код:
[Выделить все]
          " Total length: "(rtos (/ totLen 1000))); end strcat
У тебя округляет до метра если 400мм то пишет 0
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 14.06.2007, 22:16
#70
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,138


Цитата:
Сообщение от VVA
>dextron3
Возьми код с поста №62. До ввода команды EntLen, введи MM, укажи масштабный коэффициент 0.001
Не могу сообразить куда что вставить, можно сделать просто обычную сумарку примтивов без коэфициентов дополнительных

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

а дальше уже каждый будет тюнинговать по своему

VVA спасибо за ЛИСП про массивы :roll: :roll: :roll:
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 14.06.2007, 22:29
#71
Кулик Алексей aka kpblc
Moderator

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


либо меняй luprec, либо использовать строку
Код:
[Выделить все]
" Total length: "(rtos (/ totLen 1000) 2 3)); end strcat
Посмотри на опции rtos в справке
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.06.2007, 10:41
#72
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>dextron3
Возьми лисп с поста №62. Добавь в начало 2 строчки. И будешь иметь масштаб по умолчанию 0.001 и округление до 2 символов
Код:
[Выделить все]
;_==== Добавляемые строчки НАЧАЛО =======
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.001) ;_Масштаб 
;_==== Добавляемые строчки КОНЕЦ =======
(vl-load-com) 
(if (null *MIP-MODEMACRO-HTXT*)(setq *MIP-MODEMACRO-HTXT* 3.0)) ;_Высота текста 
(if (null *MIP-MODEMACRO-RTOS*)(setq *MIP-MODEMACRO-RTOS* -1.0));_Округление -1-LUPREC 
(if (null *MIP-MODEMACRO-SCALE*)(setq *MIP-MODEMACRO-SCALE* 1)) ;_Масштаб
VVA вне форума  
 
Непрочитано 15.06.2007, 13:13
#73
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,138


VVA

1) Спасибо все работет только слово "МЕТРОВ" не пишет


2) Как можно чтобы этот ЛИСП общую длинну делил на 200, количество укруглял до целого в большую сторону, а результат копировал в буфер в виде целого числа

Допустим измерели: 2398472
Результат: 11993 в буфере
ну и естественно в командной строке предварительно выврдился в таком виде 11993 шт.
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 18.06.2007, 09:48
#74
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,138


если сложно весь лисп перепечатывать скажи какую строчку заменить на какую


заранее благодарен
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 18.06.2007, 12:13
#75
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Отредактированный вариант лиспа из поста №62
Добавлено:
1. Копирование результата в clipboard Windows. Библиотеки Doslib не требуется.
2. При печати "Выбрано примитивов и т.п. ..." не печатался коэффициент
3. Для тех, кто хочет, чтобы печатались единицы измерения нужно найти строчку
Код:
[Выделить все]
"" ;_<< Добавлено 18.06.2007 сюда можно писать единицы, например метры и т.п.
И вместо "" вбить свое (например " метры")
Пример для метров
Код:
[Выделить все]
(princ (strcat "\n Выбрано примитивов: " 
           (itoa int:allEntities) 
           ", из них линейных: " 
           (itoa int:curveEntities) 
           "\nПоправочный коэфиициент K=" (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*)
           "\n Общая длина линейных примитивов: " 
        (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))
        "  метров" ;_<< Добавлено 18.06.2007 сюда можно писать единицы, например метры и т.п.
        ) ;_ strcat 
      )
Код:
[Выделить все]
;  ! ***************************************************************************
;; !                           copyToclipboard
;; ! ***************************************************************************
;; ! Function : Copy text to clipboard
;; ! Argument : 'str'     - String
;; ! Returns  : nil
;; see http://www.theswamp.org/index.php?topic=21764.new
;; ! ****************************************************************************

(defun copyToclipboard ( text / htmlfile result)
 (setq result
        (vlax-invoke
            (vlax-get
                (vlax-get
                    (setq htmlfile (vlax-create-object "htmlfile"))
                   'ParentWindow
                )
               'ClipBoardData
            )
           'SetData
            "Text"
            text
        )
    )

    (vlax-release-object htmlfile)
  result
)
(if (null *MIP-MODEMACRO-HTXT*)(setq *MIP-MODEMACRO-HTXT* 3.0)) ;_Высота текста 
(if (null *MIP-MODEMACRO-RTOS*)(setq *MIP-MODEMACRO-RTOS* -1.0));_Округление -1-LUPREC 
(if (null *MIP-MODEMACRO-SCALE*)(setq *MIP-MODEMACRO-SCALE* 1)) ;_Масштаб 
(VL-PROPAGATE '*MIP-MODEMACRO-HTXT*) 
(VL-PROPAGATE '*MIP-MODEMACRO-RTOS*) 
(VL-PROPAGATE '*MIP-MODEMACRO-SCALE*)
(defun C:entLen (/ set:entities      int:allEntities 
            int:curveEntities int:l         rea:length 
         ) 
  (princ "\nТекущий коэффициент K=")(princ (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*))
  (if (not (setq set:entities (cadr (ssgetfirst))))    ; Этот if добавлен для 
    (setq set:entities (ssget))            ; обработки предварительного 
  ) ;_ if                  ; выбора примитивов 
  (if set:entities 
    (progn 
      (setq int:allEntities 
        (sslength set:entities)   ; количество выбранных примитивов 
       int:curveEntities 
        0            ; счетчик линейных примитивов 
       int:l 0         ; счетчик 
       rea:length 
        0.0         ; общая длина линейных примитивов 
      ) ;_  setq 
      (while (< int:l (sslength set:entities)) 
   (if 
     (not 
       (vl-catch-all-error-p 
         (vl-catch-all-apply 
      'vlax-curve-getStartPoint 
      (list 
        (vlax-ename->vla-object (ssname set:entities int:l)) 
      ) ;_ list 
         ) ;_  vl-catch-all-apply 
       ) ;_  vl-catch-all-error-p 
     ) ;_  not 
      (setq int:curveEntities (1+ int:curveEntities) 
       rea:length      (+ rea:length 
                  (vlax-curve-getDistAtParam 
               (vlax-ename->vla-object 
                 (ssname set:entities int:l) 
               ) ;_ vlax-ename->vla-object 
               (vlax-curve-getEndParam 
                 (ssname set:entities int:l) 
               ) ;_ vlax-curve-getEndParam 
                  ) ;_  vlax-curve-getDistAtParam 
               ) ;_  + 
      ) ;_  setq 
   ) ;_  if 
   (setq int:l (1+ int:l)) 
      ) ;_  while 
      (setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length))
      (copyToclipboard (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)));_<< Добавлено 18.06.2007
      (princ (strcat "\n Выбрано примитивов: " 
           (itoa int:allEntities) 
           ", из них линейных: " 
           (itoa int:curveEntities) 
           "\nПоправочный коэфиициент K=" (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*)
           "\n Общая длина линейных примитивов: " 
        (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))
        "" ;_<< Добавлено 18.06.2007 сюда можно писать единицы, например метры и т.п.
        ) ;_ strcat 
      ) ;_ princ 
    ) ;_  progn 
    (alert "Примитивы не выбраны!") 
  ) ;_  if 
  (princ) 
) ;_  defun 

(defun c:MM ( / buf ) 
  (initget 7) 
  (setq *MIP-MODEMACRO-SCALE* (getreal "\nНовый масштабный коэффициент: ")) 
  (initget 6) 
  (princ "\nВысота текста <")(princ *MIP-MODEMACRO-HTXT*)(princ ">: ") 
  (if (setq buf (getdist))(setq *MIP-MODEMACRO-HTXT* buf)) 
  (initget 4 "L") 
  (princ "\nТочность округления [Luprec] <") 
  (if (< *MIP-MODEMACRO-RTOS* 0)(princ "Luprec")(princ *MIP-MODEMACRO-RTOS*)) 
  (princ ">: ") 
  (if (setq buf (getint))(setq *MIP-MODEMACRO-RTOS* (if (numberp buf) buf -1)))
  (VL-PROPAGATE '*MIP-MODEMACRO-HTXT*) 
  (VL-PROPAGATE '*MIP-MODEMACRO-RTOS*) 
  (VL-PROPAGATE '*MIP-MODEMACRO-SCALE*) 
  (princ) 
  ) 
(defun c:LP ( )(if (= (type *MIP-LENGTH*) 'REAL)(progn 
(vla-addtext(vla-get-block(vla-get-ActiveLayout(vla-get-ActiveDocument(vlax-get-acad-object)))) 
(rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))  
(vlax-3d-point '(0 0 0)) *MIP-MODEMACRO-HTXT*)(princ "\n Укажите точку вставки текста:") 
(command "_.copybase" '(0 0 0) (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause))) 
(princ))

Последний раз редактировалось VVA, 19.09.2015 в 12:04. Причина: Версия copyToclipboard без создания объекта IE
VVA вне форума  
 
Непрочитано 18.06.2007, 12:32
#76
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>dextron3
1. см. п.3
В начало по прежнему добавь эти строки
Код:
[Выделить все]
;_==== Добавляемые строчки НАЧАЛО ======= 
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков 
(setq *MIP-MODEMACRO-SCALE* 0.001) ;_Масштаб 
;_==== Добавляемые строчки КОНЕЦ =======
2.
Цитата:
общую длинну делил на 200
Это то же самое, что умножить на 0.005
Код:
[Выделить все]
(setq *MIP-MODEMACRO-SCALE* 0.005) ;_Масштаб  / 200
Для округления в большую сторону надо вставить строчку
Было
Код:
[Выделить все]
(setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length))
(copyToclipboard (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)));_<< Добавлено 18.06.2007
Должно стать
Код:
[Выделить все]
(setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length))
(setq *MIP-LENGTH* (fix (+ *MIP-LENGTH* 0.999))) ;_<<Округление
(copyToclipboard (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)));_<< Добавлено 18.06.2007
VVA вне форума  
 
Непрочитано 18.06.2007, 16:51
#77
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,138


VVA

какойто вирусованный лисп N75, автокад сразу вылетает предварительно минут пять повисев


что то тут не так
[ATTACH]1182170952.JPG[/ATTACH]
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 18.06.2007, 17:24
#78
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>dextron3
Разберись со своим антивирусом или файерволлом.
В автокаде с помощью ActiveX создается копия internet explorera, чтобы с помощью его методов занести данные в clipboard.

Вот 4 сточки. Заносит строку ZZZ в буфер
1. Создаем объект IE
Код:
[Выделить все]
(setq ieobj (vlax-get-or-create-object "InternetExplorer.Application"))
2. Задаем пустую стриницy
Код:
[Выделить все]
(vlax-invoke ieobj 'navigate2 "about:blank")
3. Заносим в clipboard строку ZZZ
Код:
[Выделить все]
(vlax-invoke(vlax-get(vlax-get (vlax-get ieobj 'document) 'parentwindow) 
'clipboarddata) 
'setdata 
"text" 
"ZZZ"
)
4.Удаляем объект IE
Код:
[Выделить все]
(vlax-release-object ieobj)
Выполни их пошагово, на какой вылетает?
VVA вне форума  
 
Непрочитано 19.06.2007, 10:53
#79
dextron3

проектировшик
 
Регистрация: 01.01.2007
СССР
Сообщений: 5,138


спасибо VVA

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

заранее благодарен

clipboard что то меня не устраивает

и на этом лиспе данная тема будет исчерпана
:arrow:
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 19.06.2007, 18:21
#80
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Код:
[Выделить все]
;Опубликовано http://forum.dwg.ru/showthread.php?p=146973#post146973
(vl-load-com) 
(defun C:entLen200 (/ set:entities      int:allEntities 
            int:curveEntities int:l         rea:length
*MIP-MODEMACRO-HTXT* *MIP-MODEMACRO-RTOS* *MIP-MODEMACRO-SCALE*
         )
(setq *MIP-MODEMACRO-HTXT* 3.0) ;_Высота текста 
(setq *MIP-MODEMACRO-RTOS* 0);_Округление -1-LUPREC 
(setq *MIP-MODEMACRO-SCALE* 0.005) ;_Масштаб 1/200 
  
  (princ "\nТекущий коэффициент K=")(princ (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*)) 
  (if (not (setq set:entities (cadr (ssgetfirst))))    ; Этот if добавлен для 
    (setq set:entities (ssget))            ; обработки предварительного 
  ) ;_ if                  ; выбора примитивов 
  (if set:entities 
    (progn 
      (setq int:allEntities 
        (sslength set:entities)   ; количество выбранных примитивов 
       int:curveEntities 
        0            ; счетчик линейных примитивов 
       int:l 0         ; счетчик 
       rea:length 
        0.0         ; общая длина линейных примитивов 
      ) ;_  setq 
      (while (< int:l (sslength set:entities)) 
   (if 
     (not 
       (vl-catch-all-error-p 
         (vl-catch-all-apply 
      'vlax-curve-getStartPoint 
      (list 
        (vlax-ename->vla-object (ssname set:entities int:l)) 
      ) ;_ list 
         ) ;_  vl-catch-all-apply 
       ) ;_  vl-catch-all-error-p 
     ) ;_  not 
      (setq int:curveEntities (1+ int:curveEntities) 
       rea:length      (+ rea:length 
                  (vlax-curve-getDistAtParam 
               (vlax-ename->vla-object 
                 (ssname set:entities int:l) 
               ) ;_ vlax-ename->vla-object 
               (vlax-curve-getEndParam 
                 (ssname set:entities int:l) 
               ) ;_ vlax-curve-getEndParam 
                  ) ;_  vlax-curve-getDistAtParam 
               ) ;_  + 
      ) ;_  setq 
   ) ;_  if 
   (setq int:l (1+ int:l)) 
      ) ;_  while 
      (setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length)) 
      (setq *MIP-LENGTH* (fix (+ *MIP-LENGTH* 0.999))) ;_<<Округление 
      (princ (strcat "\n Выбрано примитивов: " 
           (itoa int:allEntities) 
           ", из них линейных: " 
           (itoa int:curveEntities) 
           "\nПоправочный коэфиициент K=" (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*) 
           "\n Общая длина линейных примитивов: " 
        (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)) 
        " шт." ;_<< Добавлено 18.06.2007 сюда можно писать единицы, например метры и т.п. 
        ) ;_ strcat 
      ) ;_ princ 
    ) ;_  progn 
    (alert "Примитивы не выбраны!") 
  ) ;_  if 
  (princ) 
) ;_  defun

Последний раз редактировалось VVA, 19.09.2015 в 12:04.
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен LISP для суммы длин отрезков линни

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

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