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

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

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

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

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

Полилиния не подходит т.к. эти отрезки разбросаны по всему чертежу, а надобы выбрав несколько линий узнать их общую длинну.
Просмотров: 120814
 
Непрочитано 26.02.2004, 11:29
#2
master_vlad


 
Сообщений: n/a


Okonechnikov A.N.
FOCAL V1.0
 
 
Непрочитано 26.02.2004, 11:34
#3
Dima

инженер
 
Регистрация: 30.08.2003
Одесса-Мама
Сообщений: 172
Отправить сообщение для Dima с помощью Skype™


А куда намылить?
__________________
vinum
Dima вне форума  
 
Автор темы   Непрочитано 26.02.2004, 11:41
#4
ilka_t


 
Регистрация: 20.01.2004
Москва
Сообщений: 154


ilka_T@mail.ru
ilka_t вне форума  
 
Непрочитано 26.02.2004, 12:12
#5
{Smirnoff}

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


Если только для отрезков, то вот простая щелкалка:
Код:
[Выделить все]
(defun c:llen (/ ent_set sum_len cur_ent vla_obj obj_dump len)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq ent_set (ssadd))
  (setq sum_len 0.0)
  (while T
    (setq cur_ent (car(entsel "Select Line: ")))
    (if (= cur_ent nil)(alert "Nothing entity selected!"))
    (sssetfirst nil (ssadd cur_ent ent_set))
    (setq vla_obj (vlax-ename->vla-object cur_ent))
    (if(= T (vlax-property-available-p vla_obj "Length"))
      (progn 
      (setq len (vla-get-length vla_obj)
 	    sum_len (+ sum_len len))
      );end progn
      (progn
      (ssdel cur_ent ent_set)
      (alert "Selected entity is not Line!")
      );end progn
      );end if
    (terpri)
    (princ (strcat "**** Sum length="(rtos sum_len)" ****"))
    (terpri)
    );end while
  (princ)
  )
{Smirnoff} вне форума  
 
Непрочитано 26.02.2004, 12:56 Сметанка
#6
Сметанка


 
Регистрация: 14.10.2003
Москва
Сообщений: 25
<phrase 1=


http://www.prodtp.ru/modules.php?op=...ownload&sid=22
Сметанка вне форума  
 
Автор темы   Непрочитано 26.02.2004, 14:10
#7
ilka_t


 
Регистрация: 20.01.2004
Москва
Сообщений: 154


Спасибо....
ilka_t вне форума  
 
Непрочитано 26.02.2004, 15:18
#8
Grinzaid

Архитектор
 
Регистрация: 14.10.2003
Израиль
Сообщений: 365
<phrase 1=


Нашёл у себя такой лиспик:
Код:
[Выделить все]
(defun C:SUMLINES ()
(setq total 0)

(setq p nil)
(gc)

(prompt "\nSelect the lines you want to sum the lengths of: ")
(setq p (ssget))
(if p 
   (progn
     (setq n (sslength p))
     (setq l 0)
       (while (< l n)
           (if (= "LINE" (cdr (assoc 0 (setq elist (entget (ssname p l))))))
              (progn
                (setq start (cdr (setq as (assoc 10 elist))))
                (setq finish (cdr (setq as (assoc 11 elist))))
                (setq delta (distance start finish))
                (grdraw start finish -1)
                (setq total (+ total delta))
                (grtext -2 (strcat "Total: " (rtos total)))
              )
           )
            (setq l (1+ l))
          )
    )  
)
(print)
(write-line (strcat "Variable TOTAL has the sum of the length of the lines: " (rtos total)))
(graphscr)
)
__________________
С уважением,
Влад Гринзайд.
Grinzaid вне форума  
 
Непрочитано 26.02.2004, 15:24
#9
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


А вот и еще... http://www.autocad.ru/docs/doc_3098.htm
Подсчитывает общую длину указанных примитивов (не только линий, но полилиний, дуг и т.д.).
Впрочем приведу код здесь:
Код:
[Выделить все]
(vl-load-com)
(defun entLen (/ set:OfEnts int:l rea:LengthOfEnts)
  (setq  set:OfEnts (ssget)
  int:l 0
  rea:LengthOfEnts
   0.0
  ) ;_ setq
  (while (< int:l (sslength set:OfEnts))
    (setq rea:LengthOfEnts
     (+ rea:LengthOfEnts
        (vlax-curve-getDistAtParam
    (vlax-ename->vla-object (ssname set:OfEnts int:l))
    (vlax-curve-getEndParam (ssname set:OfEnts int:l))
        ) ;_ vlax-curve-getDistAtParam
     ) ;_ +
    ) ;_ setq
    (setq int:l (1+ int:l))
  ) ;_ while
  (princ (strcat "\nПримитивов: - "
     (itoa (sslength set:OfEnts))
     "\nОбщая длина: - "
     (rtos rea:LengthOfEnts)
   ) ;_ strcat
  ) ;_ princ
  (prin1)
) ;_ defun
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Автор темы   Непрочитано 26.02.2004, 16:03
#10
ilka_t


 
Регистрация: 20.01.2004
Москва
Сообщений: 154


Всем спасибо
ilka_t вне форума  
 
Непрочитано 26.02.2004, 17:55
#11
Геннадий aka PG

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


http://cadhlp.kulichki.com/pg2/focall.zip
__________________
С уважением,
Геннадий aka PG
Геннадий aka PG вне форума  
 
Непрочитано 26.02.2004, 23:36
#12
{Smirnoff}

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


Браво! На примере Kos, видно отличие ЛИСП-программиста, от нас ЛИСП-любителей... :?
{Smirnoff} вне форума  
 
Непрочитано 27.02.2004, 11:22
#13
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Цитата:
Сообщение от Fantomas
Браво! На примере Kos, видно отличие ЛИСП-программиста, от нас ЛИСП-любителей... :?
Заблуждение. Я тоже любитель, только с большим стажем...

Модератору (или кто там за это отвечает): зачем прикрепили эту тему? Если кому нужно и интересно - есть поиск. С прикрепленными темами - перебор (ИМХО). Я в них даже не лажу (может и зря), надоедает читать одно и то же...
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 06.04.2004, 12:27
#14
lee


 
Регистрация: 28.02.2004
43
Сообщений: 1,631
<phrase 1=


Поддерживаю kos. С закрепленными темами перебор
lee вне форума  
 
Непрочитано 03.06.2004, 17:57 как эти тектсы применять?
#15
Ilya


 
Сообщений: n/a


Здравствуйте.
Я не лисп-программист, хотя что за штака такая - знаю. Сохранил текст в файл *.lsp, запустил через ap. .. а какой командой каоькулятор-то запускать?
в тексте не нашел
 
 
Непрочитано 03.06.2004, 19:10
#16
vk

сисадмин
 
Регистрация: 26.08.2003
Самара
Сообщений: 1,022
<phrase 1=


Найдите (defun и гляньте, что написано дальше....

Если нечто вроде (defun entLen .... - то для запуска нужно набрать в командной строке (entLen) - именно так, со скобками, хотя регистр символов не имеет значения.

Если нечто вроде (defun C:SUMLINES .... - то для запуска нужно набрать в командной строке SUMLINES - без скобок

Если Вы имели в виду что то другое - то уточните проблему
vk вне форума  
 
Непрочитано 08.06.2004, 17:57 Спасибо vk:)
#17
Ilya


 
Сообщений: n/a


Спасибо vk
 
 
Непрочитано 10.08.2004, 04:45
#18
Vova

Engineer
 
Регистрация: 05.09.2003
New-York
Сообщений: 9,834


Kos> Твой лисп почти не имеет изъянов. Кроме одного. Если в Selection set попадает, например, блок, то он ругается и не желает считать. Получается, что надо специально готовить экран для работы программы. Поясню на своем примере. На плане этажа в разных направлениях проходят, огибая препятствия, множество труб для электричества, закладываемых в бетон перекрытия. Трубы нескольких диаметров и заканчиваются они кружком, полым или сплошным, показывающим куда выводить конец трубы-вверх или вниз. Эти кружки-блоки. Каждый диаметр расположен в своем слое. Итак, надо подсчитать погонную длину, например, труб диам. 1 дюйм. Выделяю этот слой и получаю здесь линии, дуги и блоки. Далее, прежде чем применить лисп для подсчета суммарной длины (а это можно сделать рамкой всего за 2 щелчка) надо временно удалить блоки. (А в другом случае надо и другие детали удалять). Можно ли сделать так, чтобы программа игнорировала все, что она не умеет считать и выдавала бы сообщение: я подсчитала сумму того и сяго only!
Vova вне форума  
 
Непрочитано 10.08.2004, 14:02
#19
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Цитата:
Сообщение от Vova
Kos> Твой лисп почти не имеет изъянов. Кроме одного.
Неправда. Можно накопать гораздо больше. При желании. Потому что это не законченный продукт, а заготовка.
Цитата:
Сообщение от Vova
Если в Selection set попадает, например, блок, то он ругается и не желает считать.
Да, обсчитываются только примитивы, подпадающие под определение "курва" (curve). Т.е. линейные примимтивы. Блок к ним не относится.
Цитата:
Сообщение от Vova
Можно ли сделать так, чтобы программа игнорировала все, что она не умеет считать и выдавала бы сообщение: я подсчитала сумму того и сяго only!
Можно. Но не сейчас. Я в отпуске, на работу уже два дня хожу по _крайней необходимости_. Надеюсь, что завтра уже этой необходимости не будет.

И я буду 8)
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 20.09.2004, 14:50
1 | #20
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Ну, вот отпуск и кончился...
Код:
[Выделить все]
(vl-load-com)
(defun entLen ( / set:entities int:allEntities int:curveEntities int:l rea:length)
  (setq set:entities (ssget))
  (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)))
		) ;_  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-curve-getEndParam (ssname set:entities int:l))
				     ) ;_  vlax-curve-getDistAtParam
				  ) ;_  +
	  ) ;_  setq
	) ;_  if
	(setq int:l (1+ int:l))
      ) ;_  while
      (princ (strcat "\n Выбрано примитивов: " (itoa int:allEntities)
		     ", из них линейных: " (itoa int:curveEntities)
		     "\n Общая длина линейных примитивов: " (rtos rea:length)
		     )
	     )
    ) ;_  progn
    (alert "Примитивы не выбраны!")
  ) ;_  if
(prin1)
) ;_  defun
Пробуйте...
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 20.09.2004, 16:05
#21
Геннадий aka PG

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


Цитата:
Сообщение от kos
Ну, вот отпуск и кончился...
Правильно, хватит отдыхать, за работу, за работу...
__________________
С уважением,
Геннадий aka PG
Геннадий aka PG вне форума  
 
Непрочитано 20.09.2004, 17:49
#22
Vova

Engineer
 
Регистрация: 05.09.2003
New-York
Сообщений: 9,834


Command: _appload GeneralLength.lsp successfully loaded.

Command: ; error: bad argument type: numberp: nil
Vova вне форума  
 
Непрочитано 20.09.2004, 17:54
#23
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Цитата:
Сообщение от Vova
Command: _appload GeneralLength.lsp successfully loaded.

Command: ; error: bad argument type: numberp: nil
Да-а-а?
Бум смотреть.
А в каком Автогаде? Писал под 2004.
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 20.09.2004, 18:01
#24
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Я только одного не пойму. В первом сообщении пишет, что лисп загрузился успешно. Это понятно. А где запуск функции? Что, вот так сразу сообщение об ошибке?
Может впереди еще
Код:
добавить?
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 23.09.2004, 10:41
#25
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Цитата:
Сообщение от Vova
Command: _appload GeneralLength.lsp successfully loaded.

Command: ; error: bad argument type: numberp: nil
Vova, так я не понял: работает все-таки или нет?
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 23.09.2004, 14:56
#26
Vova

Engineer
 
Регистрация: 05.09.2003
New-York
Сообщений: 9,834


На домашнем 2005 вариант от 20 сент. работает, на работе на 2004 нет. Попробую перенести из дома. Возможно, у меня некорректно выполнилось CTRL+C/V. Там русского яз. нет, но должно было работать с вопросительными знаками вместо комментариев на русском или с моим переводом. (все знаки при переводе я оставлял как было, предыдущая версия работала) Хорошо, что умеет считать в любых единицах. Результат доложу
Vova вне форума  
 
Непрочитано 23.09.2004, 21:00
#27
Vova

Engineer
 
Регистрация: 05.09.2003
New-York
Сообщений: 9,834


Все работает отлично, и на работе и дома. Спасибо KOS
Vova вне форума  
 
Непрочитано 24.09.2004, 00:15
#28
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Цитата:
Сообщение от Vova
Все работает отлично, и на работе и дома. Спасибо KOS
Дык, нема за што. Обещал ведь...
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 18.10.2004, 11:38
#29
Mike


 
Сообщений: n/a


;******************************************************************************
;
; Lsum -функция определяет суммарные длинну и площадь набора линий и полилиний
;
;******************************************************************************
(defun C:lsum (/ cmdold nabor nl i j prima sum_line sum_pline asum_pline pt_list)
(vl-load-com)
(setq cmdold (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\n Выберите линии и 2D-полилинии:\n")
(if (eq nil (setq nabor (ssget '((-4 . "<OR")
(0 . "line")
(0 . "lwpolyline")
(-4 . "OR>")
) ) ) )
(progn
(princ "***** Среди указаных объектов ни линий, ни 2D-полилиний НЕТ! *****\n")(textscr)(princ)
)
(progn
(setq nl (sslength nabor))
(setq i nl j 0 sum_line 0 sum_pline 0 asum_pline 0)
(while (< 0 i)
(setq i (1- i))
(setq prima (ssname nabor i))
(if (eq "LWPOLYLINE" (cdr (assoc 0 (entget prima))))
(progn
(command "_AREA" "_o" (ssname nabor i))
(setq sum_pline (+ sum_pline (getvar "Perimeter")))
(if (or (eq 1 (cdr (assoc 70 (entget prima))))
(equal (assoc 10 (entget prima)) (assoc 10 (reverse (entget prima))))
)
(setq asum_pline (+ asum_pline (getvar "Area")))
)
)
(progn
(setq sum_line (+ sum_line (vla-get-length (vlax-ename->vla-object prima))))
(setq pt_list (append pt_list (cdr (assoc 10 (entget prima))) (cdr (assoc 11 (entget prima)))))
(setq j (1+ j))
)
)
)
(setvar "cmdecho" cmdold)
(textscr)
(princ " Выбрано: Линий - ")(princ j)(princ "; Полилиний - ")(princ (- nl j))(princ ".\n")
(princ " Сумма длин линий - ")(princ sum_line)(princ "\n")
(princ " Суммарный периметр полилиний - ")(princ sum_pline)(princ "\n")
(princ " Сумма площадей \"замкнутых\" полилиний - ")(princ asum_pline)(princ "\n")
(princ)
)
)
)




(princ "\n Загружена утилита Lsum,\n")
(princ " вычисляющая сумму длин линий и суммарный периметр полилиний,\n")
(princ " для \"замкнутых\" полилиний вычисляется сумма площадей.\n")
(princ " Для работы с утилитой введите в командной строке Lsum.\n")
(textscr)
(princ)
 
 
Непрочитано 18.10.2004, 13:18 2 kos
#30
Alaspher


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


2 kos
Для книги "САПР на базе AutoCAD. Как это делается" был написан набор функций для подсчёта периметра примитивов. Ссылка на головную библиотечную функцию: http://www.kurganobl.ru/cad/book.jsp...=793&tn=main#b
Это библиотечные функции - для создания программы, головная, естественно, должна быть "обёрнута" интерфейсной.
Alaspher вне форума  
 
Непрочитано 18.10.2004, 13:35
#31
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Alaspher, а почему http://www.kurganobl.ru/cad/book.jsp...=793&tn=main#b адресуется только мне? Остальным тоже должно быть интересно...
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 18.10.2004, 14:08
#32
Alaspher


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


Цитата:
Сообщение от kos
Alaspher, а почему http://www.kurganobl.ru/cad/book.jsp...=793&tn=main#b адресуется только мне? Остальным тоже должно быть интересно...
Как автору похожего по типу кода (для сравнительного анализа).
А по ссылке, естественно, может сходить каждый, кому это интересно, она-ж не запаролена. Т.е., это не: "2 kos only" :-)
Alaspher вне форума  
 
Непрочитано 18.10.2004, 14:48
#33
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Alaspher, спасибо. Кстати, не далее как в пятницу принесли указанную Вами книгу. Курим...
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 02.11.2004, 21:54
#34


 
Сообщений: n/a


По наводке Fantomasa
Цитата:
Сдесь http://www.resourcecad.com в разделе Downloads. Только надо зарегистрироваться.
набрел на лиспик SUMMIT, который меряет даже длину сплайна.
 
 
Непрочитано 03.11.2004, 09:44
#35
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


Цитата:
Сообщение от Anonymous
По наводке Fantomasa
Цитата:
Сдесь http://www.resourcecad.com в разделе Downloads. Только надо зарегистрироваться.
набрел на лиспик SUMMIT, который меряет даже длину сплайна.
Процитирую сам себя (Вт Авг 10, 2004 12:02) :
Цитата:
...обсчитываются только примитивы, подпадающие под определение "курва" (curve). Т.е. линейные примимтивы. Блок к ним не относится.
А сплайн - линейный примитив и моей функцией также обсчитывается...
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 16.12.2004, 22:43
#36
proekt

конструктор
 
Регистрация: 11.12.2004
Уфа
Сообщений: 214


Зачем изобретать велосипед. Есть програмулька vetcad, там есть куча примочек для подсчетов.
proekt вне форума  
 
Непрочитано 17.12.2004, 04:16
#37
Vova

Engineer
 
Регистрация: 05.09.2003
New-York
Сообщений: 9,834


Proekt> Автокад это сплошной велодром, здесь много есть такого, что можно изобрести. LISP от KOS для подсчета суммарной длины отрезков, полилиний, дуг, сплайнов, окружностей и многоугольников, то есть всего линейного, очень хорош. Если грамотно расположить те элементы, что надо будет измерить, по слоям, или выбрать их Qselect, то эта программа моментально все просуммирует и сообщит, сколько объектов она обработала и сколько из них обсчитала, отбраковав нелинейные.
Vova вне форума  
 
Непрочитано 13.01.2005, 09:22
#38
Новичок


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


Цитата:
;******************************************************************************
;
; Lsum -функция определяет суммарные длинну и площадь набора линий и полилиний
;
;******************************************************************************
(defun C:lsum (/ cmdold nabor nl i j prima sum_line sum_pline asum_pline pt_list)
(vl-load-com)
(setq cmdold (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\n Выберите линии и 2D-полилинии:\n")
(if (eq nil (setq nabor (ssget '((-4 . "<OR")
(0 . "line")
(0 . "lwpolyline")
(-4 . "OR>")
) ) ) )
(progn
(princ "***** Среди указаных объектов ни линий, ни 2D-полилиний НЕТ! *****\n")(textscr)(princ)
)
(progn
(setq nl (sslength nabor))
(setq i nl j 0 sum_line 0 sum_pline 0 asum_pline 0)
(while (< 0 i)
(setq i (1- i))
(setq prima (ssname nabor i))
(if (eq "LWPOLYLINE" (cdr (assoc 0 (entget prima))))
(progn
(command "_AREA" "_o" (ssname nabor i))
(setq sum_pline (+ sum_pline (getvar "Perimeter")))
(if (or (eq 1 (cdr (assoc 70 (entget prima))))
(equal (assoc 10 (entget prima)) (assoc 10 (reverse (entget prima))))
)
(setq asum_pline (+ asum_pline (getvar "Area")))
)
)
(progn
(setq sum_line (+ sum_line (vla-get-length (vlax-ename->vla-object prima))))
(setq pt_list (append pt_list (cdr (assoc 10 (entget prima))) (cdr (assoc 11 (entget prima)))))
(setq j (1+ j))
)
)
)
(setvar "cmdecho" cmdold)
(textscr)
(princ " Выбрано: Линий - ")(princ j)(princ "; Полилиний - ")(princ (- nl j))(princ ".\n")
(princ " Сумма длин линий - ")(princ sum_line)(princ "\n")
(princ " Суммарный периметр полилиний - ")(princ sum_pline)(princ "\n")
(princ " Сумма площадей \"замкнутых\" полилиний - ")(princ asum_pline)(princ "\n")
(princ)
)
)
)




(princ "\n Загружена утилита Lsum,\n")
(princ " вычисляющая сумму длин линий и суммарный периметр полилиний,\n")
(princ " для \"замкнутых\" полилиний вычисляется сумма площадей.\n")
(princ " Для работы с утилитой введите в командной строке Lsum.\n")
(textscr)
(princ)
А к в этом Lisp добавить чтоб выводилась длина каждого отрезка
Подскажите пожалуйста!
Новичок вне форума  
 
Непрочитано 13.01.2005, 20:19
#39
vk

сисадмин
 
Регистрация: 26.08.2003
Самара
Сообщений: 1,022
<phrase 1=


Скорей всего что то вроде

Код:
[Выделить все]
........
(progn 
(setq l_line (vla-get-length (vlax-ename->vla-object prima)))
(princ "\nОтрезок ")
(princ l_line)
(setq sum_line (+ sum_line l_line))
(setq pt_list (append pt_list (cdr (assoc 10 (entget prima))) (cdr (assoc 11 (entget prima))))) 
(setq j (1+ j)) 
) 
.......
не проверял....
vk вне форума  
 
Непрочитано 14.01.2005, 06:15
#40
Новичок


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


Cпасибо большое!!!!!!
немного подправил и заработало
Новичок вне форума  
 
Непрочитано 04.02.2005, 15:19
#41
Apelsinov

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


Написал вот такое по совету Alaspher'а (и книжка хорошая).
Считает все что только можно.
есть грабли?

Код:
[Выделить все]
;;;******************************
;;;Apelsinov
;;;apelsinov@pochta.ru
;;;04.02.05
;;;******************************
;;;Длины выбранных примитивов
;;;Функции:
;;;apel-ssget
;;;ru-geom-get-perimeter
;;;ru-ssentget-by-type
(defun c:apel_perim (/ nab str)
  (if (setq nabor (apel-ssget "Выберите примитивы для определения суммарной длины")
      )
    (progn
      (setq
        str (strcat
              "\nСуммарная длина:"
              (rtos
                (apply '+
                       (vl-remove nil
                                  (setq nab (mapcar 'ru-geom-get-perimeter (ru-ss-to-ent-list nabor)))
                       )
                )
              )
;;;Если необходима длина каждого примитива
;;;              (apply 'strcat
;;;                     (cons "\nДлина каждого примитива:"
;;;                           (mapcar '(lambda (i) (strcat "\n" (rtos i)))
;;;                                   (vl-remove nil nab)
;;;                           )
;;;                     )
;;;              )
            )
      )
      (if (vl-member-if 'null nab)
        (setq str (strcat str
                          " \nНе учтенных примитивов из выбранных:"
                          (rtos (length (vl-remove-if-not 'null nab)))
                  )
        )
      )
    )
    (setq str "\nПримитивы не были выбраны")
  )
  (princ str)
  (princ)
)

;;;******************************
;;;Apelsinov
;;;apelsinov@pochta.ru
;;;04.02.05
;;;******************************
;;;SSget с запросом
(defun apel-ssget (str / *error*)
;;; (apel-ssget "Выбери примитивы") -> Command: Выбери примитивы <Выход>:
;;; -> <Selection set: bc> [набор]
  (defun *error* (msg /)
    (setvar "nomutt" 0)
    (princ (strcat "apel-ssget Local-Error:" msg))
  )
  (princ (strcat "\n" str " <Выход>:"))
  (if (eq 0 (getvar "nomutt"))
    (progn (setvar "nomutt" 1)
           (setq nab (ssget))
           (setvar "nomutt" 0)
           (eval nab)
    )
    (ssget)
  )
)

;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Длина периметра примитива или VLA-объекта
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *Сергей Зуев   (ShaggyDoc)
;;; *Пётр Лоскутов (Alaspher)
;;; *Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-geom-get-perimeter (ent / name)
;;;* Аргумент: Ename или VLA-Object
;;;* Если может, возвращает длинну периметра примитива, иначе - NIL.
  (if (= (type ent) 'ename)
    (setq ent (vlax-ename->vla-object ent))
  ) ;_ end of if
  (cond
    ((vlax-property-available-p ent 'length)
     (vla-get-length ent)
    )
    ((vlax-property-available-p ent 'arclength)
     (vla-get-arclength ent)
    )
    ((vlax-property-available-p ent 'circumference)
     (vla-get-circumference ent)
    )
    ((vlax-property-available-p ent 'perimeter)
     (vla-get-perimeter ent)
    )
    ((vl-position
       (setq name (vla-get-objectname ent))
       '("AcDbPolyline" "AcDb3dPolyline" "AcDbEllipse" "AcDbSpline")
     ) ;_ end of vl-position
     (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
    )
    ((vl-position name '("AcDbFace" "AcDbSolid" "AcDbTrace"))
     (ru-3dface-get-perimeter ent)
    )
    ((= name "AcDbMline") (ru-mline-get-length ent))
    ((= name "AcDbViewport") (ru-viewport-get-perimeter ent))
    (t nil)
  ) ;_ end of cond
) ;_ end of defun

;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Длина периметра трехмерной грани
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-3dface-get-perimeter (face / verts)
;;;* Аргумент: 3DFace, Trace или 2DSolid, Ename или VLA-Object
;;;* Возвращает длинну периметра примитива.
  (if (= (type face) 'vla-object)
    (setq face (vlax-vla-object->ename face))
  ) ;_ end of if
  (setq face  (entget face)
        verts (mapcar 'cdr (ru-ent-dxf-code-clear-list face '(10 11 12 13) t))
  ) ;_ end of setq
  (apply '+ (mapcar 'distance verts (cons (last verts) verts)))
) ;_ end of defun


;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Очистка заданных DXF-кодов в списке
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-ent-dxf-code-clear-list (lst list_dxf_codes is_stay_value)
  (cond
    ((null lst) NIL)
    ((/= is_stay_value (= (type (member (caar lst) list_dxf_codes)) 'list))
     (ru-ent-dxf-code-clear-list (cdr lst) list_dxf_codes is_stay_value)
    )
    (t
     (cons (car lst)
           (ru-ent-dxf-code-clear-list (cdr lst) list_dxf_codes is_stay_value)
     )
    )
  ) ;_ end of cond
)

;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Длина осевой линии мультилинии
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-mline-get-length (mline / verts)
;;;* Аргумент: мультилиния, Ename или VLA-Object
;;;* Возвращает длинну осевой мультилинии.
  (if (= (type mline) 'vla-object)
    (setq mline (vlax-vla-object->ename mline))
  ) ;_ end of if
  (setq mline (entget mline)
        verts (mapcar 'cdr
                      (vl-remove-if-not (function (lambda (x) (= (car x) 11))) mline)
              ) ;_ end of mapcar
  ) ;_ end of setq
  (if (not (zerop (logand 2 (cdr (assoc 71 mline)))))
    (setq verts (cons (last verts) verts))
  ) ;_ end of if
  (apply '+ (mapcar 'distance (cdr verts) verts))
) ;_ end of defun

;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Периметр видового экрана
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-viewport-get-perimeter (vp / clip)
;;;* Аргумент: Viewport, Ename или VLA-Object
;;;* Возвращает длинну периметра Viewport'а, в том числе clipped.
  (if (= (type vp) 'vla-object)
    (setq vp (vlax-vla-object->ename vp))
  ) ;_ end of if
  (setq vp (entget vp))
  (if (setq clip (cdr (assoc 340 vp)))
    (ru-geom-get-perimeter clip)
    (* 2 (+ (cdr (assoc 40 vp)) (cdr (assoc 41 vp))))
  ) ;_ end of if
) ;_ end of defun

;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Конвертирование набора в список примитивов
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-ss-to-ent-list (selection)
  ;; (ru-ss-to-ent-list (ru-ss-get))
  (if selection
    (vl-remove-if-not
      (function (lambda (x) (= (type x) 'ename)))
      (mapcar 'cadr (ssnamex selection))
    ) ;_ end of vl-remove-if-not
  ) ;_ end of if
) ;_ end of defun
Apelsinov на форуме  
 
Непрочитано 03.03.2005, 17:54
#42
kos

LISP-программист
 
Регистрация: 25.08.2003
Тутэйшы
Сообщений: 238


В свои коды функций на 1-ой и 2-ой страницах вставил
Код:
В связи с тем, что периодически возникают вопросы...
__________________
Там все есть для счастья - меня там только нет.
Так это значит, что я там - буду!
kos вне форума  
 
Непрочитано 05.03.2005, 13:11
#43
boker

Engineer
 
Регистрация: 01.03.2005
Israel
Сообщений: 7


Скажите плиз, что надо вводить чтоб заработал последний лисп тот что Apelsinov написал
что надо вводить в командную строку?
boker вне форума  
 
Непрочитано 05.03.2005, 13:36
#44
Torino


 
Регистрация: 21.08.2003
Штаб
Сообщений: 942
<phrase 1=


apel_perim
Torino вне форума  
 
Непрочитано 05.03.2005, 14:22
#45
boker

Engineer
 
Регистрация: 01.03.2005
Israel
Сообщений: 7


спасибо, получилось
boker вне форума  
 
Непрочитано 04.05.2005, 01:12
#46
{Smirnoff}

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


Ну что еще попробуем? Все что было до этого к сожалениию не позволяло предварительно выбрать нужные примитивы с помощью 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)
{Smirnoff} вне форума  
 
Непрочитано 04.05.2005, 09:59
#47
MIP

инженер
 
Регистрация: 13.12.2004
Минск
Сообщений: 496


>>Fantomas
А мы поступили следующим образом, навесили на кнопку макрос
Код:
[Выделить все]
^C^C(if (null C:MIP_MIPEntLen)(mi_load "mip_all"));MIPEntLen;
и все работает как часики даже с предварительным выбором и фильтрами! Замечу только что имена команды и файла содержащего Лисп, нужно заменить на заложенные у Вас!
MIP вне форума  
 
Непрочитано 04.05.2005, 11:09
#48
Apelsinov

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


>Fantomas
На вскидку - для мультилинии c:elen выдаст ошибку ....
Apelsinov на форуме  
 
Непрочитано 04.05.2005, 11:48
#49
{Smirnoff}

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


>Apelsinov
Спасибо исправил! Совсем забыл про мультилинию. С мультилинией вопрос сложный... Что мерять? Сумму длинн составляющих её линий или осевую линию как у тебя или самую длинную линию :?: Пока я её не включаю поскольку специалисты в разных областях могут получать некорректные результакты.
{Smirnoff} вне форума  
 
Непрочитано 04.05.2005, 18:36
#50
Apelsinov

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


Цитата:
Сообщение от Fantomas
Ну что еще попробуем? <...>
Еще вариант...
Для не посвященных: от предыдущего моего отличается присутствием предварительного выбора и, наверное, скоростью....может быть
А чем отличается от Фантомасовского непосвященным знать не судьба, разьве что среднюю линию для мульти считает, и еще хрень всякую...
Код:
[Выделить все]
;;;******************************
;;;Apelsinov
;;;apelsinov@pochta.ru
;;;04.05.05
;;;******************************
;;;Длины выбранных примитивов
;;;Функции:
;;;ru-geom-get-perimeter
;;;ru-ssentget-by-type
(defun c:apel_perim (/ str list_len list_len_perim)
  (vl-load-com)
  (if (cond ((ssget "I") T)
	    ((ssget))
      )
    (progn
      (setq list_len_perim
	     (vl-remove
	       nil
	       (vlax-for item
			      (vla-get-ActiveSelectionSet
				(vla-get-ActiveDocument
				  (vlax-get-acad-object)
				)
			      )

		 (setq
		   list_len
		    (cons (ru-geom-get-perimeter item)
			  list_len
		    )
		 )
	       )
	     )
      )
      (setq
	str
	 (strcat
	   "\n Total length for "
	   (rtos (length list_len_perim))
	   " entities:"
	   (rtos (apply
		   '+
		   list_len_perim
		 )
	   )
	 )
      )
      (if (vl-member-if 'null list_len)
	(setq str
	       (strcat str
		       "\n "
		       (rtos (length (vl-remove-if-not 'null list_len)))
		       " were filtered out (unsupported type)"
	       )
	)
      )
    )
    (setq str "\n Nothing selected")
  )
  (princ str)
  (princ)
)


;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Длина периметра примитива или VLA-объекта
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *Сергей Зуев   (ShaggyDoc)
;;; *Пётр Лоскутов (Alaspher)
;;; *Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-geom-get-perimeter (ent / name)
;;;* Аргумент: Ename или VLA-Object
;;;* Если может, возвращает длинну периметра примитива, иначе - NIL.
  (if (= (type ent) 'ename)
    (setq ent (vlax-ename->vla-object ent))
  ) ;_ end of if
  (cond
    ((vlax-property-available-p ent 'length)
     (vla-get-length ent)
    )
    ((vlax-property-available-p ent 'arclength)
     (vla-get-arclength ent)
    )
    ((vlax-property-available-p ent 'circumference)
     (vla-get-circumference ent)
    )
    ((vlax-property-available-p ent 'perimeter)
     (vla-get-perimeter ent)
    )
    ((vl-position
       (setq name (vla-get-objectname ent))
       '("AcDbPolyline" "AcDb3dPolyline" "AcDbEllipse" "AcDbSpline")
     ) ;_ end of vl-position
     (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
    )
    ((vl-position name '("AcDbFace" "AcDbSolid" "AcDbTrace"))
     (ru-3dface-get-perimeter ent)
    )
    ((= name "AcDbMline") (ru-mline-get-length ent))
    ((= name "AcDbViewport") (ru-viewport-get-perimeter ent))
    (t nil)
  ) ;_ end of cond
) ;_ end of defun

;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Длина периметра трехмерной грани
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-3dface-get-perimeter (face / verts)
;;;* Аргумент: 3DFace, Trace или 2DSolid, Ename или VLA-Object
;;;* Возвращает длинну периметра примитива.
  (if (= (type face) 'vla-object)
    (setq face (vlax-vla-object->ename face))
  ) ;_ end of if
  (setq	face  (entget face)
	verts (mapcar 'cdr
		      (ru-ent-dxf-code-clear-list face '(10 11 12 13) t)
	      )
  ) ;_ end of setq
  (apply '+
	 (mapcar 'distance verts (cons (last verts) verts))
  )
) ;_ end of defun


;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Очистка заданных DXF-кодов в списке
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-ent-dxf-code-clear-list (lst list_dxf_codes is_stay_value)
  (cond
    ((null lst) NIL)
    ((/= is_stay_value
	 (= (type (member (caar lst) list_dxf_codes)) 'list)
     )
     (ru-ent-dxf-code-clear-list
       (cdr lst)
       list_dxf_codes
       is_stay_value
     )
    )
    (t
     (cons (car lst)
	   (ru-ent-dxf-code-clear-list
	     (cdr lst)
	     list_dxf_codes
	     is_stay_value
	   )
     )
    )
  ) ;_ end of cond
)

;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Длина осевой линии мультилинии
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-mline-get-length (mline / verts)
;;;* Аргумент: мультилиния, Ename или VLA-Object
;;;* Возвращает длинну осевой мультилинии.
  (if (= (type mline) 'vla-object)
    (setq mline (vlax-vla-object->ename mline))
  ) ;_ end of if
  (setq	mline (entget mline)
	verts (mapcar 'cdr
		      (vl-remove-if-not
			(function (lambda (x) (= (car x) 11)))
			mline
		      )
	      ) ;_ end of mapcar
  ) ;_ end of setq
  (if (not (zerop (logand 2 (cdr (assoc 71 mline)))))
    (setq verts (cons (last verts) verts))
  ) ;_ end of if
  (apply '+ (mapcar 'distance (cdr verts) verts))
) ;_ end of defun

;;; ************************************************************************
;;; * Компонент Интегрированной системы ruCAD
;;; *
;;; * Периметр видового экрана
;;; *
;;; * Copyright ©2004 ruCAD Group
;;; *		Сергей Зуев   (ShaggyDoc)
;;; *		Пётр Лоскутов (Alaspher)
;;; *		Николай Полещук
;;; * http://www.kurganobl.ru/cad
;;; * РАЗРЕШАЕТСЯ ИСПОЛЬЗОВАНИЕ В КОММЕРЧЕСКИХ ПРОГРАММНЫХ ПРОДУКТАХ
;;; * ТОЛЬКО ПРИ ПОСТАВКЕ ЧАСТЕЙ ПРОДУКТА, ИСПОЛЬЗУЮЩИХ НАСТОЯЩИЙ КОМПОНЕНТ,
;;; * С ИСХОДНЫМИ ТЕКСТАМИ
;;; *
;;; ************************************************************************
(defun ru-viewport-get-perimeter (vp / clip)
;;;* Аргумент: Viewport, Ename или VLA-Object
;;;* Возвращает длинну периметра Viewport'а, в том числе clipped.
  (if (= (type vp) 'vla-object)
    (setq vp (vlax-vla-object->ename vp))
  ) ;_ end of if
  (setq vp (entget vp))
  (if (setq clip (cdr (assoc 340 vp)))
    (ru-geom-get-perimeter clip)
    (* 2 (+ (cdr (assoc 40 vp)) (cdr (assoc 41 vp))))
  ) ;_ end of if
) ;_ end of defun
Apelsinov на форуме  
 
Непрочитано 05.05.2005, 13:23
#51
{Smirnoff}

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


По поручению kos. Его вариант лиспа с предварительным выбором:
Код:
[Выделить все]
(vl-load-com)
(defun entLen (/ set:entities      int:allEntities
            int:curveEntities int:l         rea:length
         )
  (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
      (princ (strcat "\n Выбрано примитивов: "
           (itoa int:allEntities)
           ", из них линейных: "
           (itoa int:curveEntities)
           "\n Общая длина линейных примитивов: "
           (rtos rea:length)
        ) ;_ strcat
      ) ;_ princ
    ) ;_  progn
    (alert "Примитивы не выбраны!")
  ) ;_  if
  (prin1)
) ;_  defun
Кто следующий :?:
{Smirnoff} вне форума  
 
Непрочитано 16.05.2005, 16:27
#52
Georg

Design
 
Регистрация: 27.10.2004
Kiev
Сообщений: 57


Я нашел в форуме Лисп считающий сумму площадей, а мне нужен список площадей объектов в порядке их выбора :?

Apelsinov сделал удобную вещицу для списка длин линий

Код:
[Выделить все]
;;;Если необходима длина каждого примитива 
;;;              (apply 'strcat 
;;;                     (cons "\nДлина каждого примитива:" 
;;;                           (mapcar '(lambda (i) (strcat "\n" (rtos i))) 
;;;                                   (vl-remove nil nab) 
;;;                           ) 
;;;                     ) 
;;;              ) 
            )
пользуюсь, очень удобно
весь лисп на второй странице этой темы

можно прицепить такой же вагончик к подсчету площадей?
Georg вне форума  
 
Непрочитано 16.05.2005, 16:49
#53
{Smirnoff}

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


>Georg

Глянь, может приблизително подойдет http://dwg.ru/forum/viewtopic.php?t=3312 . Эта прога выводит отдельные площади, правда еще плюс габариты и "габаритные" площади. Габаритные прамоугольники и надписи можно и не чертить (опция), а если они начерчены то удаляются одной командой.
{Smirnoff} вне форума  
 
Непрочитано 31.08.2006, 15:48
#54
Styx

проектировщик ОВ и ТМ
 
Регистрация: 16.08.2005
Ростов-на-Дону
Сообщений: 106


Цитата:
Сообщение от Apelsinov
Цитата:
Сообщение от Fantomas
Ну что еще попробуем? <...>
Еще вариант...
Для не посвященных: от предыдущего моего отличается присутствием предварительного выбора и, наверное, скоростью....может быть
А чем отличается от Фантомасовского непосвященным знать не судьба, разьве что среднюю линию для мульти считает, и еще хрень всякую...
При выборе мультилинии в ACAD2006 выдает:
Select objects:
; error: no function definition: RU-GEOM-GET-PERIMETER


:?: :?:
__________________
Between...
Styx вне форума  
 
Непрочитано 16.09.2006, 14:51
#55
Karales


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


Ищу LISP (и.т.п) для измерения длин труб(цилиндров) разных диаметров.
Karales вне форума  
 
Непрочитано 11.05.2007, 17:58 грузится, но не выполняется
#56
you_you


 
Регистрация: 11.05.2007
Одесса
Сообщений: 2


Работаю в ACAD 2007
Сохранил тект от kos`а со второй странице этой темы, подгрузил, но:
Command: _appload entLen.lsp successfully loaded.
Command:
Command:
Command: entLen
Unknown command "ENTLEN". Press F1 for help.

методом научного тыка определил, что выполняется только один лисп :
Код:
[Выделить все]
(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)
)
Где искать причину?
you_you вне форума  
 
Непрочитано 11.05.2007, 21:17
#57
Мечтатель


 
Регистрация: 18.04.2007
Самара
Сообщений: 9


Простенько считает длину линий и выдает результат в командной строке, вдруг подойдет, (не хочу показаться навязчивым грузим ap... команда summline)

(defun C:summline ( / mnv l i td p1 p2)
(setq mnv (ssget) i 0 td 0)
(setq l (if (null mnv) 0 (sslength mnv)))
(repeat l
(setq sp (entget (ssname mnv i)) i (1+ i))
(if (= (cdr (assoc 0 sp)) "LINE" ) (progn
(setq p1 (cdr (assoc 10 sp)) p2 (cdr (assoc 11 sp)))
(setq td (+ (distance p1 p2) td))
))
)
(princ "\nL=") (princ td)
(prin1)
)
Мечтатель вне форума  
 
Непрочитано 11.05.2007, 21:19
#58
Мечтатель


 
Регистрация: 18.04.2007
Самара
Сообщений: 9


чет не доглядел страницы до конца, постыдился бы выкладывать
Мечтатель вне форума  
 
Непрочитано 12.05.2007, 08:11
#59
Кулик Алексей aka kpblc
Moderator

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


> you_you: лисп kos'a вызывать как (entlen), то есть со скобками. Если хочешь вызывать без скобок, замени строку
Код:
[Выделить все]
(defun entLen ( / set:entities int:allEntities int:curveEntities int:l rea:length)
на
Код:
[Выделить все]
(defun c:entLen ( / set:entities int:allEntities int:curveEntities int:l rea:length)
После этого вызов с ком.строки будет как entlen.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.05.2007, 11:38
#60
you_you


 
Регистрация: 11.05.2007
Одесса
Сообщений: 2


> Кулик Алексей aka kpblc
Спасибо, помогло.
you_you вне форума  
 
Непрочитано 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,792
<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,758


[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,042


Цитата:
Сообщение от {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,792
<phrase 1= Отправить сообщение для VVA с помощью Skype™


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

Фотограф
 
Регистрация: 01.01.2007
Алматы
Сообщений: 5,042


Цитата:
Сообщение от 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,042


Цитата:
Сообщение от 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
С.-Петербург
Сообщений: 36,674


либо меняй 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,792
<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,042


VVA

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


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

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

Фотограф
 
Регистрация: 01.01.2007
Алматы
Сообщений: 5,042


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


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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,792
<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,792
<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,042


VVA

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


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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,792
<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,042


спасибо VVA

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

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

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

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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,792
<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 вне форума  
 
Непрочитано 19.06.2007, 18:22
#81
VVA

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


*** Удалено *** Повторение поста № 80
VVA вне форума  
 
Непрочитано 21.06.2007, 16:48
#82
Джек

Строительство
 
Регистрация: 03.09.2003
Нижний Новгород
Сообщений: 81
<phrase 1=


Всем привет!!!
Я вот пользуюсь программой который сделал автор Крыс. Спасибо ему огромное!!!!! 8)
Код:
[Выделить все]
(defun c:mlen2 (/ adoc selset layer_list init _kpblc-string-subst 
item sum_len)
  (vl-load-com)
  (setq  adoc  (vla-get-activedocument (vlax-get-acad-object))
  sum_len  0.0
  ) ;_ end of setq
  (vla-startundomark adoc)
  (if
    (setq ent (entsel "\nУкажите примитив, с которого брать слой 
<Выход> : "))
     (progn
       (setq selset (ssget (list (assoc 8 (entget (car ent))))))
       (while (and selset
       (> (sslength selset) 0)
       ) ;_ end of and
   (setq item (ssname selset 0))
   (ssdel item selset)
   (setq item    (vlax-ename->vla-object item)
         sum_len (+ sum_len
        (if (vlax-property-available-p item 'length)
          (vla-get-length item)
          (cond
            ((= (strcase (vla-get-objectname item) t) "acdbarc")
             (vla-get-arclength item)
             )
            ((= (strcase (vla-get-objectname item) t) "acbcircle")
             (* pi 2.0 (vla-get-radius item))
             )
            (t 0.0)
            ) ;_ end of cond
          ) ;_ end of if
        ) ;_ end of +
         ) ;_ end of setq
   ) ;_ end of while
       (setq sum_len_m (/ sum_len 1000.0)) ;; перевод мм в м
       (setq sum_len_m_10% (* 1.1 sum_len_m))
       (alert
	 (strcat "\n Общая длина примитивов " (rtos sum_len 2 2) " мм"
		 "\n или "(rtos sum_len_m 2 2)" м. "
                 "\n С учетом коэфф. запаса " (rtos sum_len_m_10% 2 2)" м."
		 		 ) ; end strcat
	 ); end alert
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
Программа хорошая , но есть не большие замечания, не видно (забываешь) с какого слоя выбирается объекты.
Можно переделать программу чтоб она считала отрезки, полилинии , только ВКЛЮЧЕННЫХ слоев и выдавала список.
Например:
Слой 1 – общая длина ХХ
Слой 11 – общая длина ХХХ
Спасибо. Джек.
Джек вне форума  
 
Непрочитано 21.06.2007, 17:59
#83
VVA

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


>Джек Так чего остановился на mlen2? далее есть и mlen3 от Евгения Елпанова.
LISP. Подсчет длины линий на определенном слое

Последний раз редактировалось VVA, 02.07.2010 в 14:24.
VVA вне форума  
 
Непрочитано 21.06.2007, 18:48
#84
dextron3

Фотограф
 
Регистрация: 01.01.2007
Алматы
Сообщений: 5,042


VVA

протестировал по полной
спасибо лисп работает так, как и хотелось,
:wink: :wink: :wink: :wink: :wink: :wink:

и за лисп с массивами отдельное спасибоспасибо
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума  
 
Непрочитано 22.06.2007, 09:50
#85
Джек

Строительство
 
Регистрация: 03.09.2003
Нижний Новгород
Сообщений: 81
<phrase 1=


VVA спасибо за совет!
Но хотелось не много по другому!!!!!!
Хотелось чтоб программа считала отрезки, полилинии , только ВКЛЮЧЕННЫХ слоев и выдавала список.
:roll: Например:
Слой 1 – общая длина ХХ
Слой 11 – общая длина ХХХ
Спасибо. Джек.
Джек вне форума  
 
Непрочитано 06.08.2007, 14:52
#86
F5623


 
Регистрация: 06.08.2007
Тула
Сообщений: 1


А как сделать так, чтобы результаты выводились не только в командной строке, а еще и возле курсора?
F5623 вне форума  
 
Непрочитано 12.02.2008, 19:12
#87
МИНЗДРАВ

Oxypropane welder
 
Регистрация: 29.01.2008
Unix
Сообщений: 578


Что делать с этими кодами, что-бы суммарную длинну выделенных линий посчитать?
Нельзя, что-нибудь без программирования для пользователя выложить?

Последний раз редактировалось МИНЗДРАВ, 12.02.2008 в 19:34. Причина: Глупые умники достают!!!
МИНЗДРАВ вне форума  
 
Непрочитано 12.02.2008, 21:44
#88
Кулик Алексей aka kpblc
Moderator

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


Что делать: dwg.ru/art/8
Без программирования: нет. Ну или руками выписывать на бумажку длины и потом складывать.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.02.2008, 23:52
#89
Dym


 
Регистрация: 27.09.2005
Двинскъ
Сообщений: 595
Отправить сообщение для Dym с помощью Skype™


штучка от Александра Ривилиса
особо хороша в паре этим

Последний раз редактировалось Dym, 12.02.2008 в 23:59.
Dym вне форума  
 
Непрочитано 13.02.2008, 20:07
#90
МИНЗДРАВ

Oxypropane welder
 
Регистрация: 29.01.2008
Unix
Сообщений: 578


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
dwg.ru/art/8
Прочитал. Применил. Но ни один код не работает!
Что-то пишет там, шевелится. Но заветного числа, я не вижу (ничего похожего в наборе символов там нет).
Подскажите где это самое число видно должно быть?
Может оно где, в специальном укромном файле сохраняется?
МИНЗДРАВ вне форума  
 
Непрочитано 14.02.2008, 09:16
#91
VVA

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


Что применил-то? Советую #89
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 14.02.2008, 09:56
#92
kubik67

гл. констр.
 
Регистрация: 05.10.2007
Санкт-Петербург
Сообщений: 83


на сайте выложен хороший калькулятор - calcacad - он суммирует и длину линий, и многое другое. Поищи в даунлоаде, я постоянно им пользуюсь.
kubik67 вне форума  
 
Непрочитано 15.02.2008, 17:04
#93
Mikha

Highway Design
 
Регистрация: 16.09.2007
Tver
Сообщений: 27


>>МИНЗДРАВ
Посмотри здесь http://dwg.ru/dnl/2733
и здесь http://dwg.ru/dnl/486

Последний раз редактировалось Mikha, 15.02.2008 в 17:14.
Mikha вне форума  
 
Непрочитано 27.03.2008, 10:19
#94
VDeNisV


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


Всё хорошо, а вот можно ли сделать так, чтоб считал он примитивы в разных слоях отдельно и в Exel бы такую табличку отправлял (название файла, имя слоя, длинна примитивов). Если не сложно
VDeNisV вне форума  
 
Непрочитано 27.03.2008, 12:28
#95
VVA

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


А ты сходи по ссылке из #83 на последнюю страничку и почитай про mlen4 и mlen41
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.03.2008, 12:47
#96
VDeNisV


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


Спасибо огромное! То что нужно!
VDeNisV вне форума  
 
Непрочитано 21.04.2008, 03:37
#97
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


а можно сделать наоборот: имеется линия, откладываем нужный размер от ее начала, и она разрывается в этом месте???
skkkk вне форума  
 
Непрочитано 21.04.2008, 18:08
#98
МИНЗДРАВ

Oxypropane welder
 
Регистрация: 29.01.2008
Unix
Сообщений: 578


Цитата:
Сообщение от skkkk Посмотреть сообщение
имеется линия, откладываем нужный размер от ее начала, и она разрывается в этом месте???
Это легко достигается встроенными средствами AutoCada/
МИНЗДРАВ вне форума  
 
Непрочитано 26.04.2008, 06:29
#99
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, подскажите пожалуйста, как поменять в вашем лиспе с поста 62 точку на запятую в результате?

МИНЗДРАВ, А для непрямой полилинии есть возможность обойтись встроенными средствами??Расскажите пожалуйста)

VVA, и еще просьба....подскажите, как записать ответ в готовый текст (оверрайт вроде), предварительно приплюсовав к нему число....Заранее спасибо:-)

Последний раз редактировалось Кулик Алексей aka kpblc, 26.04.2008 в 14:31.
skkkk вне форума  
 
Непрочитано 28.04.2008, 10:07
#100
VVA

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


skkkk,
1. Добавил код в #62
3. Там такой возможности не предусматривалось. Быстро можно взять код с поста #366 И воспользоваться командой sumTE. Правда настройка разделителя (точка или запятая) будет в новой версии.
Цитата:
А для непрямой полилинии есть возможность обойтись встроенными средствами??Расскажите пожалуйста)
Команда разметь (_measure) откладывает расстояния вдоль оси выбранного примитива. Это может быть и "кривая" полилиния или не менее "кривой" сплайн
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 28.04.2008, 11:37
#101
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, дай Бог Вам здоровья!!
skkkk вне форума  
 
Непрочитано 28.04.2008, 12:44
#102
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Цитата:
Сообщение от VVA Посмотреть сообщение
skkkk
Там такой возможности не предусматривалось...
и невозможно предусмотреть?

Цитата:
Сообщение от VVA Посмотреть сообщение
skkkk
Команда разметь (_measure) откладывает расстояния вдоль оси выбранного примитива. Это может быть и "кривая" полилиния или не менее "кривой" сплайн
Разметил, долго думал, как разбить потом полилинию в местах разметки точками, пришел к тому, что на эти точки реагирует привязка "узел". А нельзя проще их делить, например взорвать полилинию как-нибудь в местах разметки?
skkkk вне форума  
 
Непрочитано 30.04.2008, 01:27
#103
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


А можно подправить лисп с # 62 так, чтобы он только записывал результат в готовый текст, без приплюсовки числа?(я изменил вопрос из #99). Для приплюсовки я нашел другой лисп. Уж очень неудобно центрировать этот текст вне таблицы
skkkk вне форума  
 
Непрочитано 30.04.2008, 10:15
#104
VVA

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


Команда LP переименована в LPN (Length Print to New text)
Добавлена команда LPE (Length Print to Existing text)
В качестве "приемника" подсчитанной длины может выступать текст, мтекст, размер, ячейка таблицы, атрибут блока
Код:
[Выделить все]
(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 TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
;;Length Print to Existing text
(defun c:LPE ( )
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." ","  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))
;;Length Print to New text
(defun c:LPN ( )(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))
(princ "\nНаберите в командной строке:
          \nEntLen - подсчет примитивов
          \nMM - масштабный коэффициент и настройка
          \nLPN - результат в новый текст
          \nLPE - результат в существующий текст")
(princ)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.04.2008, 12:35
#105
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, огромное спасибо! Работает!! Только хотелось бы так:
ввожу "_entLen", выбираю примитивы, enter, кликаю текст для вставки. Реально? И тут нужна точка в разделителе. Забыл сразу сказать. Это мне нужно для задачи, так скажем, № 1. Для другой задачи (условно назовем ее №2) я использую лисп с #62, за что Вам отдельное спасибо. В нем я удалил строчку
Код:
[Выделить все]
(defun c:LP ( )(if (= (type *MIP-LENGTH*) 'REAL)(progn
и стало так: ввожу команду, выбираю объекты, enter и появляется текст с результатом возле курсора(вот здесь мне нужен разделитель-запятая) - все так как надо!!!
А вот с #104 такой вариант не прошел.
skkkk вне форума  
 
Непрочитано 30.04.2008, 12:48
#106
VVA

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


Ты сам то не запутаешься где точка, а где нет?
Точка на запятую меняется здесь
Код:
[Выделить все]
 
(vl-string-translate "." ","
Можешь из LPE создать свою команду с точкой. Скопируй код и замени "," на "."
Код:
[Выделить все]
(defun c:LPE1 ( )
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))
Цитата:
ввожу "_entLen", выбираю примитивы, enter, кликаю текст для вставки. Реально?
Создай кнопку
^C^CENTLEN;LPE;
Или команду
Код:
[Выделить все]
 
(defun C:SKKK ()
  (C:ENTLEN) ;_ Вызов команды ENtlen из лиспа
  (C:LPE)    ;_ Вызов команды LPE из лиспа
  )
По такому образу и подобию наклепай себе команд столько, сколько хочешь или сможешь, только не запутайся
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.04.2008, 14:35
#107
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Спасибо,VVA.А я разобрался, как переделать лисп из #104.
Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(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 TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))
Настроил кнопку. Теперь нажимаю на нее, выбираю объекты (линии), правый клик (=enter), выбираю текст для вставки оверрайтом(перезапись). Неграмотно?? Но работает.

Последний раз редактировалось skkkk, 05.05.2008 в 12:17. Причина: Исправление неточностей
skkkk вне форума  
 
Непрочитано 08.05.2008, 01:49
#108
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, а почему если вставить
Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста
в другой лисп, например для подсчета суммы мтекстов, он не округляет как надо, как это делается в лиспах с этой темы, или, поставив вопрос правильнее, может, еще чего-то не хватает? Хочется, чтоб не требуя никаких изменений настроек, каждый лисп писал заданное мной количество нулей после запятой в результате
skkkk вне форума  
 
Непрочитано 08.05.2008, 10:56
#109
VVA

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


Как правило округление происходит с помощью функции rtos, а на ее поведение влияет системная переменная dimzin
Перед вызовом лиспа установи dimzin в 0 (setvar "dimzin" 0), а еще лучше запомни предыдущее состояние, устанви в 0, сделай что нужно и восстанови dimzin обратно.
Кстати здесь в #409 выдложен лисп для суммировани и округления текстов.
Команда TORK так и делает: запрашивает кол-во знавок округления и подавлять или нет незначащие 0.
Команды sumTE и sumTN будут суммировать тексты и оставлять незначащие 0, если перед их вызовом установить dimzin в 0.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 13.05.2008, 17:48
#110
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, а почему Вы считаете:
Цитата:
...а еще лучше запомни предыдущее состояние, устанви в 0, сделай что нужно и восстанови dimzin обратно
?
Она влияет еще на что-то кроме подавления нулей?? Мне бы наоборот надо чтоб она равнялась нулю, а она часто меняется сама на 8, вроде при открытии другого файла, но я не уверен. Я даже кнопку себе вывел:
Код:
[Выделить все]
^C^C_setvar;dimzin;0
.
И подскажите пожалуйста, какая переменная отвечает за значение точности в меню Формат->Единицы?
skkkk вне форума  
 
Непрочитано 13.05.2008, 18:18
#111
VVA

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


Нет, кроме подавления нулей ни на что не влияет. Но давит нули и в размерных стилях тоже.
LUPREC - точность
LUNITS - Тип единиц
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 13.05.2008, 21:43
#112
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Можно ли как-нибудь вот эти действия заставить выполняться посредством лиспа, а не из командной строки:
Код:
[Выделить все]
^C^C_setvar;dimzin;0
^C^C_setvar;luprec;2?
Другими словами, как их выразить языком лисп?
Хотелось бы их добавить в нужный лисп, назначив, видимо, кнопке макрос
Код:
[Выделить все]
^C^C(Load "лисп.lsp");команда,
чтобы при запуске определенного лиспа назначенной кнопкой эти переменные менялись соответствующим образом
skkkk вне форума  
 
Непрочитано 13.05.2008, 23:12
#113
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Непонятно зачем в командной строке было _setvar использовать - имени переменной вполне хватает. В лиспе это выглядит (setvar "dimzin" 0) (setvar "luprec" 2).
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 14.05.2008, 04:05
#114
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Дима_, с этим:
Цитата:
В лиспе это выглядит (setvar "dimzin" 0) (setvar "luprec" 2)
-я не разобрался, но нашел вариант:
Код:
[Выделить все]
(command "dimzin" 0)
(command "luprec" 2)
-вставляю это в лисп, и переменные меняются при запуске лиспаподскажите, люди, в чем ошибся мой научный тык
А насчет:
Цитата:
зачем в командной строке было _setvar использовать
-действительно, зачем? Самоучкам тяжко бывает

Последний раз редактировалось skkkk, 15.05.2008 в 02:34.
skkkk вне форума  
 
Непрочитано 18.05.2008, 04:07
#115
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, я успешно пользуюсь кодом с поста #107. Но вот возникла мысль, а можно ли его зациклить? То есть, нажимаю кнопку вызова лиспа, выбираю объекты, правая кнопка(=enter), кликаю текст для вставки, и тут же снова появляется приглашение программы выбрать объекты(без повторного вызова команды), и так по кругу с выходом по esc. Пробовал манипуляции с макросом с поста #106(^C^CENTLEN;LPE по аналогии с зацикливанием "break at point" по совету с форума (*^C^C_break;\_f;\@) - ничего не вышло . Может циклить надо в самом лиспе?
skkkk вне форума  
 
Непрочитано 19.05.2008, 09:45
#116
VVA

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


Оставь лисп #107 как есть и добавь к нему этот кусочек
Код:
[Выделить все]
(defun C:ENTLEN* ()(while t (C:ENTLEN)))
Вызов ENTLEN*
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.05.2008, 02:43
#117
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, спасибо............. Правда, прежде, чем увидел Ваш ответ, я нашел его на соседнем сайте в теме про изменение цвета текста лиспом, причем, в Вашем же лиспе (http://www.caduser.ru/cgi-bin/f1/board.cgi?t=42402mx)
Эта тема, кстати, меня и заинтересовала изменением цвета текста лиспом. Хочется, чтобы при выборе мтекста для вставки результата, результат записывался белым цветом, при том, что исходный мтекст был другого цвета...Ну понимаете, для того, чтоб было видно, ЧТО я уже обработал, а что - нет. И хотелось бы более ли менее универсальный совет, т.е. чтоб я мог добавить, допустим, код и в другой лисп, например для суммы мтекстов.......
Пробовал как-то совмещать лиспы с кодом из вышеуказанной ссылки, но знаний пока маловато...
skkkk вне форума  
 
Непрочитано 20.05.2008, 10:37
#118
VVA

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


skkkk,
Модифицировал код из поста №107
Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(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 TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p
      (vl-catch-all-apply
	'(lambda()
	   (vla-put-TextString vlaObj pasteStr)
	   (vla-put-Color vlaObj 3)  ;3-номер цвета
	   )
	)
      )
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))
Нужное выделено красным цветом
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 23.05.2008, 12:42
#119
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, дай Бог Вам детишек смышленных и веселых......Как всегда круто Еще бы один штришок....Как сделать, чтоб при вызове функции entlen выбрать только одну линию, а следующим кликом левой кнопки на текст перезаписывать его значение? Т.е. чтобы enter нажимался автоматом после выбора одной линии. Куда-то надо вставить двойные кавычки?? Только пробовал я это - не вышло
skkkk вне форума  
 
Непрочитано 23.05.2008, 12:51
#120
VVA

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


Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(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:entLen1 (/ 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 "_:E:S"))            ; обработки предварительного 
  ) ;_ 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 TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p
      (vl-catch-all-apply
	'(lambda()
	   (vla-put-TextString vlaObj pasteStr)
	   (vla-put-Color vlaObj 3)  ;3-номер цвета
	   )
	)
      )
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.05.2008, 09:40
#121
dextron3

Фотограф
 
Регистрация: 01.01.2007
Алматы
Сообщений: 5,042


сделали
__________________
инженер проектировшик с опттом программа авто гад образование высшие

Последний раз редактировалось dextron3, 25.02.2009 в 13:16.
dextron3 вне форума  
 
Непрочитано 30.05.2008, 14:21
#122
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, а реально лиспом сделать следующее? Есть некое количество вертикальных отрезков. Под каждым снизу с небольшим смещением расположены вертикально ориентированные мтексты. Выделить скопом все отрезки, затем выделить все тексты. И чтобы длина каждой линии отобразилась с коэффициентом в "своем", т.е. близлежащем тексте. Расстояние между отрезками разное.
skkkk вне форума  
 
Непрочитано 30.05.2008, 15:05
#123
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Расстояние наверное не будет играть роль, если алгоритм будет основан на поочередной обработке объектов, сначала отрезки(первый, второй.....n-ый), потом мтексты (первый, второй.....n-ый)
skkkk вне форума  
 
Непрочитано 25.06.2008, 11:09
#124
vsegdasam


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


пожалуста, скажите простым русским языком для начинающего, как померить общую длину разных отрезков?
vsegdasam вне форума  
 
Непрочитано 25.06.2008, 11:11
#125
Кулик Алексей aka kpblc
Moderator

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


dwg.ru/art/8
+ FAQ
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 09.07.2008, 04:19
#126
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Господа Гуру, подскажите пожалуйста, как можно значение суммы длин линий слоя связать с полем либо с ячейкой таблицы, то есть, чтобы в поле или ячейке динамически отображалась эта величина?
skkkk вне форума  
 
Непрочитано 09.07.2008, 10:47
#127
VVA

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


skkkk, Читай здесь Связь графических объектов и текста
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.07.2008, 02:34
#128
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, а по поводу #122 не сможете подсказать?
skkkk вне форума  
 
Непрочитано 25.02.2009, 11:03
#129
samogonshik

injener
 
Регистрация: 21.01.2007
Kazakhstan
Сообщений: 26
<phrase 1=


извините, а как все это внедрить в программу?
__________________
Оптимизм - это когда не моешь посуду вечером, надеясь, что утром на это будет больше охоты
samogonshik вне форума  
 
Непрочитано 25.02.2009, 21:04
#130
Кулик Алексей aka kpblc
Moderator

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


См.подпись VVA.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 28.08.2009, 06:45
#131
Аннагельды


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


Подскажите пожалуйста как подсчитать сумму отрезков длин и как использовать LIPS
Аннагельды вне форума  
 
Непрочитано 28.08.2009, 08:04
#132
Кулик Алексей aka kpblc
Moderator

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


На один пост вверх посмотри.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 28.08.2009, 12:20
#133
Игорь Костюкович


 
Регистрация: 31.07.2009
Минск
Сообщений: 40


Цитата:
Сообщение от Аннагельды Посмотреть сообщение
... и как использовать LIPS
LIPS - губы (англ.) Неужели нужна инструкция по эксплуатации?
У модераторов прошу отдельного пардону за офф. Не сдержался...
Игорь Костюкович вне форума  
 
Непрочитано 10.12.2009, 13:01
#134
Shish

Руководитель проектов
 
Регистрация: 15.09.2009
Москва
Сообщений: 85


Не подскажете, в чем проблема:

Команда: (entlen)
найдено: 38
; ошибка: no function definition: VLAX-ENAME->VLA-OBJECT

Последний раз редактировалось Shish, 10.12.2009 в 13:12.
Shish вне форума  
 
Непрочитано 10.12.2009, 13:28
#135
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Shish Посмотреть сообщение
Не подскажете, в чем проблема:

Команда: (entlen)
найдено: 38
; ошибка: no function definition: VLAX-ENAME->VLA-OBJECT
выполни команду (vl-load-com) и почитай Как использовать код на Лиспе
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
 
Непрочитано 10.12.2009, 13:35
#136
Shish

Руководитель проектов
 
Регистрация: 15.09.2009
Москва
Сообщений: 85


У меня lisp с этой команды начинается. Kos об этом позаботился.

http://forum.dwg.ru/showpost.php?p=24124&postcount=42

Последний раз редактировалось Shish, 10.12.2009 в 13:47.
Shish вне форума  
 
Непрочитано 10.12.2009, 13:59
#137
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Shish, выполни две команды:
Код:
результат выложи посмотреть. Буду медитировать дальше.
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
 
Непрочитано 10.12.2009, 14:04
#138
Shish

Руководитель проектов
 
Регистрация: 15.09.2009
Москва
Сообщений: 85


Команда: (_VER)
"RTS v.5.0a0-20b"

Команда: (ver)
"Visual LISP 2008 (ru)"

Спасибо за заботу!
Shish вне форума  
 
Непрочитано 10.12.2009, 14:32
#139
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


попробуй еще:
Код:
[Выделить все]
(eval vlax-ename->vla-object)
Похоже, у тебя сбой в библиотеках автокада...
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
 
Непрочитано 11.12.2009, 10:16
#140
Shish

Руководитель проектов
 
Регистрация: 15.09.2009
Москва
Сообщений: 85


Команда: (eval vlax-ename->vla-object)
nil

А Entlen по-прежнему выдает ошибку.
Shish вне форума  
 
Непрочитано 11.12.2009, 10:19
#141
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Shish Посмотреть сообщение
Команда: (eval vlax-ename->vla-object)
nil
Самое быстрое и простое решение в данном случае - переустановка автокада...
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
 
Непрочитано 11.12.2009, 10:39
#142
Shish

Руководитель проектов
 
Регистрация: 15.09.2009
Москва
Сообщений: 85


Блин, плохо... Кнопочки, цвета, крестики, все ж опять настраивать... Можно все настройки каким-нибудь одним файлом сохранить? Понимаю, что можно и F1 нажать, но... лень.

Жень, спасибо за помощь! Переустановил, все работает. Рабочее пространство сохранил мастером переноса пользовательских настроек.

Последний раз редактировалось Shish, 11.12.2009 в 13:32.
Shish вне форума  
 
Непрочитано 13.01.2010, 17:01
#143
Aндрeй


 
Регистрация: 23.08.2007
Москва
Сообщений: 529


Как все-таки коэффициент менять, только в коде?
мм не работает...
Aндрeй вне форума  
 
Непрочитано 16.01.2010, 15:51
#144
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Андрей, нельзя ли подробнее вопрос поставить?
skkkk вне форума  
 
Непрочитано 24.01.2010, 20:23
#145
Aндрeй


 
Регистрация: 23.08.2007
Москва
Сообщений: 529


Цитата:
Сообщение от skkkk Посмотреть сообщение
Андрей, нельзя ли подробнее вопрос поставить?
Как задается масштаб?
Только в коде, изменением *MIP-MODEMACRO-SCALE*?
Либо есть еще какие-то варианты после запуска?
Aндрeй вне форума  
 
Непрочитано 25.01.2010, 10:23
#146
VVA

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


Цитата:
Сообщение от Aндрeй Посмотреть сообщение
Как задается масштаб?
Только в коде, изменением *MIP-MODEMACRO-SCALE*?
Либо есть еще какие-то варианты после запуска?
Есть. Уточни, из какого поста скопировал код? В #104 есть команды
Цитата:
(princ "\nНаберите в командной строке:
\nEntLen - подсчет примитивов
\nMM - масштабный коэффициент и настройка
\nLPN - результат в новый текст
\nLPE - результат в существующий текст")
В принципе можно докопировать команду к своему коду.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.01.2010, 10:25
#147
ktstar


 
Регистрация: 25.07.2007
ПОЛТАВА
Сообщений: 7


Установите Веткад... Там есть "суперкалькулятор". У него есть функция суммирование длин линий, дуг, окружностей, разбросанных по всему чертежу.... У меня стоит версия 3.3
ktstar вне форума  
 
Непрочитано 29.12.2010, 12:44
#148
DiF


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


Добрый день! Подскажите пожалуйста.
Есть чертеж, схема сети, на ней разными слоями нанесены емкости кабелей.
Необходимо сосчитать их суммарную длину и умножить на некий коэффициент, который соответствует реальному расстоянию.

Можно это как то сделать автоматически?

На первой взяд lips, он отлично считает выбеленные отрезки, но может быть как-то можно выделить сразу все отрезки одного слоя на модели?
Спасибо большое!
DiF вне форума  
 
Непрочитано 29.12.2010, 12:55
#149
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,873


Цитата:
Сообщение от DiF Посмотреть сообщение
может быть как-то можно выделить сразу все отрезки одного слоя на модели
(ssget "_x" '((0 . "LINE") (410 . "Model") (8 . Имя слоя")))
Nike вне форума  
 
Непрочитано 29.12.2010, 13:17
#150
VVA

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


Цитата:
Сообщение от DiF Посмотреть сообщение
Есть чертеж, схема сети, на ней разными слоями нанесены емкости кабелей.
Необходимо сосчитать их суммарную длину и умножить на некий коэффициент, который соответствует реальному расстоянию.
Команда MLEN41
Остальные варианты LISP. Подсчет длины линий на определенном слое
Код:
[Выделить все]
;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=44&TID=20298&PAGEN_1=3
;|================== XLS ========================================
* Опубликовано http://www.caduser.ru/forum/index.php...&TID=19920
               http://www.caduser.ru/forum/index.php...&TID=31444
               http://www.caduser.ru/forum/index.php...&TID=31669
* Автор: Владимир Азарко aka VVA
* Назначение: Печать списка данных Data-list в Excell
*             Для вывода создается новый лист
* Аргументы:
              Data-list — список списков данных (LIST) вида
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Каждый список вида (Value1 Value2 ... VlalueN) записывается
                            в отдельную строку в соответствующие столбцы (Value1-A Value2-B и .т.д.)
                  header —  список (LIST) заголовков или nil вида ("Подпись A" "Подпись B" ...)
                            Если header nil, принимается ("X" "Y" "Z")
                 Colhide —  список буквенных названий стоблцов для скрытия или nil — не скрывать
                            ("A" "C" "D") — скрыть столбцы A, C, D
                 Name_list — имя нового листа активной книги или nil — новая книга
* Возврат: nil
* TIPS!!! : При передачи функции xls числовых вещественных данных нет необходимости проверять текущий системный
            разделитель целой и дробной части ("HKEY_CURRENT_USER\\Control Panel\\International" "sDecimal")
            Функцией на время вывода отключается использование в Excele системного разделителя, разделителем
            целой и дробной части устанавливается точка. После завершения ф-ции все восстанавливается.
Пример вызова
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Столбец1" "Столбец2" "Столбец3" "Столбец4") '("B"))|;
(vl-load-com)
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
              *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
    (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
    (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
;_Команда MLEN41
(defun c:mlen41 (/ m ss clist temp)
  (defun sort (lst predicate)
    (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
  )
  (defun combine (inlist is-greater is-equal / sorted current result)
    (setq sorted (sort inlist is-greater))
    (setq current (list (car sorted)))
    (foreach item (cdr sorted)
      (if (apply is-equal (list item (car current)))
  (setq current (cons item current))
  (progn
    (setq result (cons current result))
    (setq current (list item))
  )
      )
    )
    (cons current result)
  )
  (defun mlen4_1 (lst / sum_len)
    (setq sum_len 0)
    (foreach item (mapcar 'car lst)
      (setq
  sum_len  (+ sum_len
       (if (vlax-property-available-p item 'length)
         (vla-get-length item)
         (cond
           ((=
        (strcase (vla-get-objectname item) t)
        "acdbarc"
      ) ;_  =
      (vla-get-arclength item)
           )
           ((=
        (strcase (vla-get-objectname item) t)
        "acbcircle"
      ) ;_  =
      (* pi 2.0 (vla-get-radius item))
           )
           (t 0.0)
         ) ;_  cond
       ) ;_  if
    ) ;_  +
      )
    )
    (if  (not (zerop sum_len))
      (princ
  (strcat "\n\t" (cdar lst) " = " (rtos (* sum_len m) 2 4))
      )
    )
    (list (cdar lst)(rtos (* sum_len m) 2 4))
  )
  (vl-load-com)
  (if (null *M*)(setq *M* 1))
  (initget 6)
  (and
    (princ "\nВведите маштабный коэффициент <")
    (princ *M*)(princ ">: ")
    (or (setq m (getreal))
   (setq m *M*)
   )
    (setq *M* m)
    (setq ss (ssget "_:L"))
    (setq ss (mapcar
         (function vlax-ename->vla-object)
         (vl-remove-if
     (function listp)
     (mapcar
       (function cadr)
       (ssnamex ss)
     ) ;_  mapcar
         ) ;_ vl-remove-if
       )
    )
    (mapcar '(lambda (x)
         (setq temp (cons (cons x (vla-get-Layer x)) temp))
       )
      ss
    )
    (setq clist  (combine temp
       '(lambda (a b)
          (> (cdr a) (cdr b))
        )
       '(lambda (a b)
          (eq (cdr a) (cdr b))
        )
    )
    )
    (princ
      "\n\n  Общая длинна всех линейных примитивов по слоям:"
    )
    (setq temp (mapcar 'mlen4_1 clist))
    (xls temp '("Слой" "Длина") nil "mlen41")
  )
  (princ)
) ;_  defun
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 29.12.2010, 14:00
#151
DiF


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


Спасибо. Спасибо огромное. =)
DiF вне форума  
 
Непрочитано 24.06.2011, 22:03 (LISP) Подсчет отрезков по слоям и вывод в XLS файл.., Помогите пожалуйста.
#152
AutoS


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


Всем привет.
Нужна программа на LISP, которая будет подсчитывать количество примитивов в каждом слое и потом записывать все это в XLS файл.
Заранее Большое Спасибо.
AutoS вне форума  
 
Непрочитано 24.06.2011, 22:07
#153
Кулик Алексей aka kpblc
Moderator

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


_.qselect, выписать на бумажку, вбить в ексль.
Большое Пожалста.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 24.06.2011, 22:16
#154
AutoS


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


Спасибо.
Это вроде как не подходит..
Например если имеется 100+ слоев..
Нужна программка которая пере клацает все слои и впишет количество примитивов под именем каждого слоя в XLS файл..
Спасибо еще раз..
AutoS вне форума  
 
Непрочитано 24.06.2011, 22:27
#155
Кулик Алексей aka kpblc
Moderator

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


Есть пара встречных вопросов:
1. А как быть с примитивами, которые находятся внутри блоков или внешних ссылок?
2. Что сделано самостоятельно и на чем спотык?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 24.06.2011, 22:38
#156
AutoS


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


1- В блоках считать, в ссылках- нет (про ссылки не понял).
2- Недавний юзер AutoCAD и только только начинаю учить LISP.
В таких закидонах не силен, и потому и спрашиваю у профессионалов..
AutoS вне форума  
 
Непрочитано 24.06.2011, 23:40
#157
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,873


AutoS, нафига тебе лисп? Запусти "Извлечение данных" и сортируй по любому параметру,
Nike вне форума  
 
Непрочитано 24.06.2011, 23:50
#158
VVA

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


AutoS, Команду MLEN41 из #150 смотрел?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.06.2011, 16:51
#159
AutoS


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


VVA, смотрел, работает классно, вот только количества для каждого слоя там нет..
Было Бы очень хорошо, чтобы после столбца со слоями шел столбец с количеством, а потом длинна..
В любом случае Большое Вам Спасибо.
AutoS вне форума  
 
Непрочитано 16.01.2012, 11:33
#160
dew


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


ребята а можно переделать данный код чтобы результат можно было бы вставить в таблицу (в нужную ячейку) на чертеже

Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(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:entLen1 (/ 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 "_:E:S"))            ; обработки предварительного 
  ) ;_ 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 TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p
      (vl-catch-all-apply
        '(lambda()
          (vla-put-TextString vlaObj pasteStr)
          (vla-put-Color vlaObj 3)  ;3-номер цвета
          )
        )
      )
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))

Последний раз редактировалось Кулик Алексей aka kpblc, 16.01.2012 в 11:44.
dew вне форума  
 
Непрочитано 17.09.2015, 12:15
#161
Vilen


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


Цитата:
Сообщение от dew Посмотреть сообщение
ребята а можно переделать данный код чтобы результат можно было бы вставить в таблицу (в нужную ячейку) на чертеже

Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(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:entLen1 (/ 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 "_:E:S"))            ; обработки предварительного 
  ) ;_ 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 TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p
      (vl-catch-all-apply
        '(lambda()
          (vla-put-TextString vlaObj pasteStr)
          (vla-put-Color vlaObj 3)  ;3-номер цвета
          )
        )
      )
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))
присоединяюсь к просьбе.
если решение уже найдено, поделитесь пожалуйста, спасибо!
Vilen вне форума  
 
Непрочитано 17.09.2015, 18:20
#162
VVA

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


Vilen, А этот вариант не подойдет?

Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(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:entLen1 (/ 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 "_:E:S"))            ; обработки предварительного 
  ) ;_ 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 TTC_Paste(pasteStr keepText / nslLst vlaObj tblobj tblset pt row col lst)
(if (progn
      (initget "T Т _T T")
      (setq nslLst(nentsel "\nТекст, атрибут или размер для вставки или [ячейка Таблицы] <выход>: "))
      (if (not(listp nslLst))(setq nslLst (list nslLst)))
      )
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p
      (vl-catch-all-apply
        '(lambda()
          (vla-put-TextString vlaObj pasteStr)
          (vla-put-Color vlaObj 3)  ;3-номер цвета
          )
        )
      )
(princ "\nError. Can't pase text. "))); end condition #4
((and (= 1(length nslLst))(eq (car nslLst) "T"))
 (initget 1)
 (setq pt (getpoint "\nPick poit in table sell: "))
 (and
 ;_Проверяем, попала ли точка в ячейку таблицы
      (setq  tblobj nil tblset (ssget "_X" (list (cons 0  "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
      (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (mapcar '(lambda (x)
           (or tblobj
               (and
                 (= :vlax-true (vla-HitTest x
                               (vlax-3d-point (trans pt 1 0))
                               (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                               'row 'col))
                 (setq tblobj x)
                 )))
        lst)
      tblobj row col
      (vla-SetText tblobj row col pasteStr))); end condition #5
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))


Цитата:
Команда: entlen1

Текущий коэффициент K=0.1
Выберите объекты:

Выбрано примитивов: 1, из них линейных: 1
Поправочный коэффициент K=
Общая длина линейных примитивов: 13.32
Текст, атрибут или размер для вставки или [ячейка Таблицы] <выход>: Т

Pick poit in table sell:

Команда:
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 24.05.2017, 06:47
#163
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Всем привет. Есть рельеф земли в виде полилинии, нужно посчитать расстояние по рельефу. То есть на каждом участке суммировать с предыдущим. Смотрел здесь http://forum.dwg.ru/showpost.php?p=734502&postcount=19 но что то никак не выбрал нужную. Подскажите, пожалуйста. 4 км считать вручную через свойства тяжко
Вложения
Тип файла: dwg
DWG 2007
Рельеф.dwg (89.9 Кб, 18 просмотров)
Рyslan вне форума  
 
Непрочитано 24.05.2017, 07:35
#164
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,026


Рyslan, после просмотра файла сложилось впечатление, что Вам ведь не посчитать суммарную длину нужно (такого рода скриптов море), а вывести расстояние от начальной точки, до конца каждого отрезка, строго соблюдая последовательность и рельеф. А это несколько другая задача.
__________________
_бложиг
Boxa вне форума  
 
Непрочитано 24.05.2017, 07:40
#165
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Да да, на каждом участке рельефа сумма предыдущего и данного участка 0, 0+20, 0+20+30, 0+20+50 и так далее. И участки могут быть разной длины. Вообще рельеф идет одной полилинией. Я просто разбил ее, хотел считать вручную. Потом стал искать лисп. Пока что в Веткаде спецкалькулятором тренируюсь. Но тут текст еще корректировать нужно, поворачивать его . Но он действительно суммирует длины по участкам, уже легче
Рyslan вне форума  
 
Непрочитано 24.05.2017, 07:47
#166
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,026


Я бы попробовал без всякого программирования, порезанные отрезки загнать в ексель (_DATAEXTRACTION), с длиной и координатой Х начальной точки, отсортировал бы по координате и потом бы, в нижних ячейках просуммировал бы длины как нужно и вставил бы таблицу в акад, растянув и задав соответствующее форматирование.
Прошу прощения, стандартный DATAEXTRACTION координаты вершин полилинии не возващает.
__________________
_бложиг

Последний раз редактировалось Boxa, 24.05.2017 в 08:29.
Boxa вне форума  
 
Непрочитано 24.05.2017, 08:01
#167
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Можно попробовать. Возиться с этим экселем не охота. Я тут недавно пользовался программкой NumInc, отлично значение текста суммирует, можно массивом через интервал текст вставлять. Вот такое бы и сюда для подсчета
Рyslan вне форума  
 
Непрочитано 24.05.2017, 08:49
#168
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Рyslan, на профиле ведь обычно считают расстояние по горизонтали - пикетаж? Если так, то есть простое решение. Правильно ли я понял, что нужно записывать длину наклонных линий, а не их горизонтальное проложение?
skkkk вне форума  
 
Непрочитано 24.05.2017, 09:04
#169
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Цитата:
Сообщение от skkkk Посмотреть сообщение
на профиле ведь обычно считают расстояние по горизонтали - пикетаж?
Есть расстояния между объектами (линейные), есть расстояние по рельефу. Да нужны "наклонные полилинии", причем еще рельеф (полилинию) разбить нужно по участкам)

Вот сейчас спецкалькулятором один профиль посчитал по рельефу, конечно быстрее чем через свойства, но...может можно еще быстрее
Миниатюры
Нажмите на изображение для увеличения
Название: Профиль_подвал.png
Просмотров: 47
Размер:	131.5 Кб
ID:	188581  

Последний раз редактировалось Рyslan, 24.05.2017 в 09:10.
Рyslan вне форума  
 
Непрочитано 24.05.2017, 09:19
#170
P_S


 
Регистрация: 09.10.2006
Санкт-Петербург
Сообщений: 97


Задача ещё усложняется различием вертикального и горизонтального масштабов профиля.
P_S вне форума  
 
Непрочитано 24.05.2017, 09:29
#171
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Цитата:
Сообщение от P_S Посмотреть сообщение
Задача ещё усложняется различием вертикального и горизонтального масштабов профиля.
Масштаб не важен. если что по горизонтали полилинию отмасштабирую. главное чтоб 1:1 считал.
Рyslan вне форума  
 
Непрочитано 24.05.2017, 10:06
1 | #172
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Рyslan, набросал наскоро, бегло потестировал, вроде полет нормальный.
Сначала (временно) убираем в сторону все вертикальные объекты, не то обработает все не так, как надо (не стал делать их обработку). Затем указываем точку, от которой берется Y-координата для вставки текстов, затем указываем начальную точку (самую первую вершину первой линии, где 0.000).
Код:
[Выделить все]
 (vl-load-com)
(defun C:TEST ( / *error* oldDIMZIN ins_pt Y pt en len zoom_flag  txt_obj txt_obj_pt move_pt ss)
	(defun *error* (msg)
		(if oldDIMZIN (setvar "DIMZIN" oldDIMZIN))
		(if zoom_flag (vla-ZoomPrevious (vlax-get-acad-object)))
	)
	(setq oldDIMZIN (getvar "DIMZIN")
		  ins_pt (getpoint "\nУкажите Y-координату расположения текстов: ")
		  Y (cadr ins_pt)
		  pt (getpoint "\nУкажите стартовую точку: ")
		  ins_pt (list (car pt) Y 0.0)
		  en T
	)
	(setq len (getreal "\nВведите стартовую длину: <0.00>"))
	(if (null len) (setq len 0))
	(if (and ins_pt pt)
		(progn
			(vla-ZoomAll (vlax-get-acad-object))
			(setq zoom_flag T)
		)
	)
	(setvar "DIMZIN" 0)
	(while (and pt ins_pt en)
		(or (setq len len) (setq len 0))
		(setq txt_obj 
			(vla-AddMText 
				(vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object)))
				(vlax-3d-point ins_pt)
				0
				(vl-string-subst "," "." (rtos len 2 2))
			)
		)
		(vla-put-AttachmentPoint txt_obj 4)
		(vla-put-Rotation txt_obj (/ pi 2))
		(setq txt_obj_pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint txt_obj)))
			  move_pt (list (car txt_obj_pt) Y 0.0)
		)
		(vla-Move txt_obj (vlax-3D-point txt_obj_pt) (vlax-3D-point move_pt))
		(setq ss 
			(ssget 
				"_C"
				(polar pt (/ pi 4) 0.01)
				(polar pt (/ (* 5 pi) 4) 0.01)
				(list (cons 0 "LWPOLYLINE"))
			)
		)
		(if (and en (= (type en) 'ENAME)) (setq ss (ssdel en ss)))
		(setq en (ssname ss 0))
		(if en 
			(setq pt (vlax-curve-getEndPoint en)
				  len 
					(if len
						(+ len (vlax-curve-getDistAtPoint en pt))
						(vlax-curve-getDistAtPoint en pt)
					)
				  ins_pt (list (car pt) Y 0.0)
			)
		)
	)
	(*error* nil)
)
Результат во вложении.

----- добавлено через ~6 мин. -----
Цитата:
Сообщение от Рyslan Посмотреть сообщение
причем еще рельеф (полилинию) разбить нужно по участкам
LISP. Разорвать объекты в точках пересечения. BreakObjects.

----- добавлено через ~22 мин. -----
Посмотрел скрин-пример в #169 - стало ясно, что не нужно везде делать префикс "0.000+", да и два знака после запятой там. Исправил
Вложения
Тип файла: dwg
DWG 2010
Рельеф.dwg (102.0 Кб, 13 просмотров)

Последний раз редактировалось skkkk, 24.05.2017 в 12:51.
skkkk вне форума  
 
Непрочитано 24.05.2017, 11:58
#173
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


skkkk Супер, спасибо! А можно еще добавить выбор, чтобы не всегда с 0 считала, а с выбранной цифры?
Рyslan вне форума  
 
Непрочитано 24.05.2017, 12:22
#174
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Рyslan, а как? С выбранного места она считает с любого, но первое число - 0. Как проге "объяснить", сколько было до этого линий, и какая стартовая длина? В число первых запросов добавить выбор объекта (текстового) из которого возьмется начальная длина? Или просто запросить число?
skkkk вне форума  
 
Непрочитано 24.05.2017, 12:30
#175
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Цитата:
Сообщение от skkkk Посмотреть сообщение
Или просто запросить число?
Ладно, что-то я наглею ))) Пусть так останется. Вот у меня например 3 профиля, первый я разбил и от 0 посчитал. Вторую полилинию стыкую с первой, также разбиваю, убираю подсчет от 0 и заново уже две линии считаю, точно также с третьей. Тогда все цифры получаются по порядку, просто их потом на разные профиля раскидал. Большое пребольшое спасибо!!! То что я полдня обсчитывал, твоя программа сделала за 15 минут
Рyslan вне форума  
 
Непрочитано 24.05.2017, 12:51
#176
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Цитата:
Сообщение от Рyslan Посмотреть сообщение
Ладно, что-то я наглею )))
Ладно уж, это ж мелочи
Добавил запрос стартовой длины. Если на этот запрос нажать Enter, то будет ноль.
Обновил в #172.
Если будет удобнее, можно вместо ввода длины взять ее с текста. Это несложно.

----- добавлено через ~8 мин. -----
Тут есть еще один момент. Надо, чтобы направление полилинии, обозначающей поверхность земли, до разбивки на куски по 20 м (по горизонтали) было слева направо. Проверить можно, выбрав полилинию и потыкать пункт "Вершины" в свойствах. Обратить - с помощью _PEDIT. Просто прога сканирует у каждого куска (разбитой полилинии) вершины от левой к правой (от начальной к конечной), берет новый кусок справа, ставит его длину - и так, пока не кончатся куски.
skkkk вне форума  
 
Непрочитано 24.05.2017, 13:10
#177
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Спасибо! Я понял, я ее недавно Оверкилом чистил. Я вот щас сравнил первый вариант со вторым, почему то пересчет был с разницей 0,01. Обрати внимание на последнюю длину
Вложения
Тип файла: dwg
DWG 2013
Рельеф.dwg (78.2 Кб, 16 просмотров)

Последний раз редактировалось Рyslan, 24.05.2017 в 13:17.
Рyslan вне форума  
 
Непрочитано 24.05.2017, 18:49
#178
VVA

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


Цитата:
Сообщение от skkkk Посмотреть сообщение
Надо, чтобы направление полилинии, обозначающей поверхность земли, до разбивки на куски по 20 м (по горизонтали) было слева направо
Не проблема перед применением твоей программы проверить и реверсировать, при необходимости, все полилинии по часовой как отдельной командой, так и включив пару функций в твой код
http://www.cadtutor.net/forum/showth...l=1#post405249
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 24.05.2017, 19:23
#179
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


VVA, никак не возьму в толк: что значит "по часовой". С замкнутыми - ясно, а вот у меня строго горизонтальная полилиния с направлением обхода слева на право. Она - по часовой или против в данном контексте? Или сверху вниз - она как? Как-то пытался связаться с этим "клоквайзом", чтобы определить угол поворота полилинии - влево или вправо по ходу движения (кажется, нашел функцию Евгения Елпанова) - сломал весь мозг, с моей логикой она не увязалась, и я сделал по-другому. Попробовал коды из твоей ссылки - еще больше сбился с толку. PL-CW вообще ничего не делает, а PL-CCW меняет направление на обратное. А как сделать по-любому слева направо, так и не понял.

Рyslan, кстати, ты пока нет-нет да и проверяй результаты. Выбери все полилинии до какого-то текста с их суммой и проверь суммарную длину (думаю, знаешь, как). Мало ли чего.

----- добавлено через ~21 мин. -----
Цитата:
Сообщение от Рyslan Посмотреть сообщение
Я вот щас сравнил первый вариант со вторым, почему то пересчет был с разницей 0,01. Обрати внимание на последнюю длину
Только сейчас увидел эту дописку. Разница в 0.01 - это старая как мир (программирования) проблема - результат вычислений над числами с плавающей запятой. Ты в первый раз скорее всего прогнал прогой весь профиль, а второй - по частям, вводя на началах разбитых фрагментов длину с клавиатуры с двумя знаками после запятой. В первом случае третий знак после запятой не пишется, но участвует в расчетах. И в сумме он может дать, например, 0.004 или 0.005. При округлении до двух знаков третий знак теряется, и не складывается далее с последующими, округляясь по математическим правилам: 0.04 -> 0.0, а 0.05 -> 0.1. Во втором случае третий знак потерялся, и не просуммировался с последующими значениями, поэтому и разница в 0.1. Чтобы этого избежать, надо в расчетах брать не все знаки после запятой, а переводить обратно в число строку, которая вписывается в текст. Конечно, тысячная метра для геодезии - фигня, но осадок остается, и некоторые придирчивые проверялы прям потирают ручки при виде подобных оплошностей. Подправлю по возможности, вместе с обработкой направления полилиний, когда пойму, как это сделать.
skkkk вне форума  
 
Непрочитано 24.05.2017, 21:57
#180
VVA

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


Цитата:
Сообщение от skkkk Посмотреть сообщение
чтобы определить угол поворота полилинии - влево или вправо по ходу движения
Здесь выложил функцию D. C. Broad, Jr. sideof
Цитата:
Сообщение от VVA Посмотреть сообщение
;;; D. C. Broad, Jr.
;;; (sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
;;; return values
;;; negative = point is to the right side of the ray
;;; 0 = point is on the ray
;;; otherwise point is on the left side of the ray.
;;; P1 should not equal P2 for meaningful results.
Позволяет узнать, справа или слева от луча находится проверяемая точка
По поводу PL-CW, PL-CCW - в основе код Евгения Елпанова, корни нужно искать на caduser'e и там, по моему, для точного определения направления нужно 3 точки.

Цитата:
Сообщение от skkkk Посмотреть сообщение
PL-CW вообще ничего не делает
Значит считается, что обход линии идет по часовой и нет необходимости реверсировать линию

Цитата:
Сообщение от skkkk Посмотреть сообщение
PL-CCW меняет направление на обратное
Значит считается, что обход линии идет по часовой и нужно реверсировать линию
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.05.2017, 12:48
#181
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Цитата:
Сообщение от VVA Посмотреть сообщение
Значит считается, что обход линии идет по часовой и нет необходимости реверсировать линию
В том то и дело, что я пытался эти команды применять к горизонтальной полилинии, которую реверсировал вручную, а затем применял эти команды. Первая ничего не делает, как бы я линию не повернул. А вторая - реверсирует, тоже, как бы я ее не повернул. Вот тебе, бабушка, и Юрьев день
Где я и что делаю не так?
В контексте последнего кода подумываю над тем, чтобы просто проверять, на каждой новой полилинии в цикле, начало ли полилинии "нащупалось", и если нет, то просто реверсировать ее.
skkkk вне форума  
 
Непрочитано 26.05.2017, 12:09
#182
P_S


 
Регистрация: 09.10.2006
Санкт-Петербург
Сообщений: 97


По-моему, что-то вы перемудрили. Исходная задача какая: есть единая полилиния рельефа, и надо записать в графе профиля расстояния по ней с определённым шагом по пикетажу. Это можно сделать в одном цикле, и не надо ничего рвать и выбирать каждый раз новую полилинию. Направление исходной, конечно, надо проверить.
В общем, какой-то такой функционал получается:
Код:
[Выделить все]
 (princ "\nУкажите линию рельефа")
(setq graf    (vlax-ename->vla-object
                (ssname (ssget "_:S" '((0 . "LWPOLYLINE"))) 0))
      step    (getint "Введите шаг:  ")
      ins_pt  (cadr (getpoint "\nУкажите Y-координату начала строк: "))
      m_sp    (vla-get-ModelSpace
                (vla-get-ActiveDocument (vlax-get-acad-object)))
      t_const (append
                '((0 . "TEXT")
                  (100 . "AcDbEntity")
                  (67 . 0)
                  (410 . "Model")
                  (100 . "AcDbText")
                  (50 . 1.5708))
                (list (cons 40 (getreal "\nВведите высоту текста:  ")))
                '((41 . 1.0)
                  (51 . 0.0)
                  (7 . "Standard")
                  (71 . 0)
                  (72 . 0))) ;DXF-коды, общие для всех текстовых меток
      begin   (vlax-curve-getStartPoint graf)
      )
(entmakex (append t_const
                  (list (cons 1 "0.00")
                        (list 10 (car begin) ins_pt 0.0))))
(setq begin (list (+ step (car begin)) (cadr begin)))
(while (setq per
              (vlax-variant-value
                (vla-IntersectWith
                  graf
                  (vla-AddLightWeightPolyline
                    m_sp
                    (vlax-safearray-fill
                      (vlax-make-safearray vlax-vbDouble '(0 . 3))
                      (list (car begin)
                            (- (cadr begin) 1000)
                            (car begin)
                            (+ (cadr begin) 1000))))
                  acExtendOtherEntity)))
  (entdel (entlast))
  (entmakex
    (append t_const
            (list (cons 1
                        (rtos (vlax-curve-getDistAtPoint
                                graf
                                (vlax-curve-getClosestPointTo
                                  graf
                                  (vlax-safearray->list per)))
                              2
                              2))
                  (list 10 (car begin) ins_pt 0.0))))
  (setq begin (list (+ step (car begin)) (cadr begin)))
  ) ;end of while
P_S вне форума  
 
Непрочитано 26.05.2017, 15:44
#183
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Цитата:
Сообщение от P_S Посмотреть сообщение
По-моему, что-то вы перемудрили
Вообще-то - да. Хотя, я бы сказал, "недомудрил". Вообще ничего не продумывал особо. Поэтому и сразу назвал команду "TEST". Полилинию, конечно, можно не разбивать. Просто в файле с исходной задачей она была уже разорванна в клочья. Я подумал, что это результат работы какой-то программы, поэтому не стал вдаваться в подробности и сделал применительно к файлу-задаче. К тому моменту, как я прочитал (что надо еще и разрывать), добрая часть кода уже родилась Поэтому я переделывать уже не стал - время свободное вышло, просто дал ссылку на "разбивалку".
Я подумал вот что. Надо дать Рyslan'у немного поработать "в бою", может, он еще что выявит. И в случае необходимости, чтобы код стал действительно рабочим, надо будет чуток доработать его с учетом:
1. Не бить линию на куски.
2. Добавить проверку направления обхода вершин.
3. Добавить обработку плавающей точки. Вот тут момент спорный. Если сделать, чтобы результат обработки линий по частям (за два-три захода со вводом вместо нуля предыдущего значения) совпадал с результатом обработки цельной полилинии, то в итоге конечная цифра будет до нескольких десятых метра расходится с длиной линии в свойствах. Даже и не знаю, как тут правильно поступить. Может, разумнее будет вводить стартовую длину до трех знаков после запятой? Или запрашивать не число, а линию и брать длину с нее?
Вопрос еще в том, насколько эта программа перейдет в разряд необходимых, может, это просто разовая (двух-) задача?

----- добавлено через 58 сек. -----
P.S.: P_S, кстати, у Вас теряется последний текст.
skkkk вне форума  
 
Непрочитано 27.05.2017, 19:23
#184
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Всем привет! Спасибо за помощь! Я полилинию разбивал, чтобы через свойства посчитать длину. Но если можно будет не разбивая посчитать, то это вообще шикарно! skkkk я результаты подсчета после твоей программы не проверял )))) надеюсь там все ок ))))
Рyslan вне форума  
 
Непрочитано 29.05.2017, 11:06
#185
P_S


 
Регистрация: 09.10.2006
Санкт-Петербург
Сообщений: 97


Да, выход из цикла у меня получился с ошибкой (safearray с нулевым значением не есть nil), так что корректно получается что-то такое:
Код:
[Выделить все]
 (defun C:TEST  (/ graf step ins_pt m_sp t_const begin per)
  (princ "\nУкажите линию рельефа")
  (setq graf    (vlax-ename->vla-object
                  (ssname (ssget "_:S" '((0 . "LWPOLYLINE"))) 0))
        step    (getint "Введите шаг:  ")
        ins_pt  (cadr (getpoint "\nУкажите Y-координату начала строк: "))
        m_sp    (vla-get-ModelSpace
                  (vla-get-ActiveDocument (vlax-get-acad-object)))
        t_const (append
                  '((0 . "TEXT")
                    (100 . "AcDbEntity")
                    (67 . 0)
                    (410 . "Model")
                    (100 . "AcDbText")
                    (50 . 1.5708))
                  (list (cons 40 (getreal "\nВведите высоту текста:  ")))
                  '((41 . 1.0)
                    (51 . 0.0)
                    (7 . "Standard")
                    (71 . 0)
                    (72 . 0)));DXF-коды, общие для всех текстовых меток
        begin   (vlax-curve-getStartPoint graf)
        )
  (entmakex (append t_const
                    (list (cons 1 "0.00")
                          (list 10 (car begin) ins_pt 0.0))))
  (setq begin (list (+ step (car begin)) (cadr begin)))
  (repeat (fix (/ (- (car (vlax-curve-getEndPoint graf))
                     (car (vlax-curve-getStartPoint graf)))
                  step))
    (setq per
           (vlax-safearray->list
             (vlax-variant-value
               (vla-IntersectWith
                 graf
                 (vla-AddLightWeightPolyline
                   m_sp
                   (vlax-safearray-fill
                     (vlax-make-safearray vlax-vbDouble '(0 . 3))
                     (list (car begin)
                           (- (cadr begin) 1000)
                           (car begin)
                           (+ (cadr begin) 1000))))
                 acExtendOtherEntity))))
    (entdel (entlast))
    (entmakex
      (append t_const
              (list (cons 1
                          (rtos (vlax-curve-getDistAtPoint
                                  graf
                                  (vlax-curve-getClosestPointTo
                                    graf
                                    per))
                                2
                                2))
                    (list 10 (car begin) ins_pt 0.0))))
    (setq begin (list (+ step (car begin)) (cadr begin)))
    ) ;end of repeat

  (entmakex
    (append
      t_const
      (list (cons 1 (rtos (vla-get-Length graf) 2 2))
            (list 10 (car (vlax-curve-getEndPoint graf)) ins_pt 0.0))))
  )
P_S вне форума  
 
Непрочитано 29.05.2017, 16:21
#186
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Цитата:
Сообщение от Рyslan Посмотреть сообщение
результаты подсчета после твоей программы не проверял
В том файле, на котором я делал, было все ОК. Это я имел в виду, что вдруг на других рабочих файлах какая из полилиний как-то "обратилась" к лесу задом. Хотя, если начальная была слева направо, то и результирующие куски будут такими же.
Вообще, конечно, я считаю, надежнее будет использовать алгоритм от P_S. Даже если не уследил за направлением полилинии, косяк незамеченным точно не останется - ноль справа будет. Единственное, что я еще заметил, что тексты там расставляются не строго по центру каждый над своей линией, а со смещением влево на пол высоты текста. Выравнивание у текстов - слева вверх. Если, это, конечно, важно.
skkkk вне форума  
 
Непрочитано 23.06.2017, 06:40
#187
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


P_S, skkkk Привет! Спасибо, последнюю программу посмотрел, все работает. Вопрос, а если полилиния (рельеф) разбит не на равные участки, шаг текста не получится задать одной цифрой. Можно сделать чтобы текст выставлялся над точками полилинии (без ввода шага)?
Рyslan вне форума  
 
Непрочитано 23.06.2017, 07:11
#188
Кулик Алексей aka kpblc
Moderator

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


А, может, все же в отдельную тему?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.06.2017, 07:17
#189
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Как скажешь А что сделать то надо?
Рyslan вне форума  
 
Непрочитано 23.06.2017, 08:17
#190
Кулик Алексей aka kpblc
Moderator

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


Здесь уже ничего - не станешь же фильтровать посты...
А так - сумма длин кривых и расстановка текста разные задачи. Создай новую тему, задай там вопрос, упомяни, что "начало обсуждения там-то, создал отдельную тему по просьбе модератора" - и все будет хорошо.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.06.2017, 08:27
#191
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,401


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А так - сумма длин кривых и расстановка текста разные задачи
Вообще-то этот текст и есть сумма длин кривых и программа та же. Чего плодить тему. Я думал ты хочешь эти программы вынести в другую тему. Типа "Подсчет расстояний в профиле по рельефу земли" для оформления подвала чертежа продольного профиля трубопровода
Рyslan вне форума  
 
Непрочитано 10.09.2017, 10:26
#192
Alex_Shaton


 
Регистрация: 09.09.2017
Гомель
Сообщений: 17


Уважаемые гуру! Можно ли отредактировать код из поста 62, чтобы в чертеж вставлялась бы не округленное значение длины полилинии, а сумма значений длин сегментов, округленных до первого знака после запятой?
Alex_Shaton вне форума  
 
Непрочитано 10.09.2017, 14:16
1 | 3 #193
Кулик Алексей aka kpblc
Moderator

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


Можно. Редактируй.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 11.09.2017, 01:11
#194
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,270


Чем отличается сумма значений длин сегментов полилинии от ее общей длины?
skkkk вне форума  
 
Непрочитано 11.09.2017, 07:27
#195
trir


 
Регистрация: 18.12.2010
Сообщений: 3,429


Цитата:
Чем отличается сумма значений длин сегментов полилинии от ее общей длины?
округлением
trir вне форума  
 
Непрочитано 23.04.2018, 11:15
#196
Loolik


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


Уважаемые форумчане, подскажите, как изменить ЛИСП из 104 сообщения, чтобы при выполнении он вписывал существующее значение переменной, а при нажатии на Enter принимал это же значение
Цитата:
Сообщение от VVA Посмотреть сообщение
Код:
[Выделить все]
 
(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) 
)
Пытался сделать так, текущее значение получаю, но после нажатия Enter число не принимается, и приходится все равно вручную вбивать нужную цифру.
Код:
[Выделить все]
 
(defun c:MM ( / buf ) 
(initget 7)
;; Получаю переменную, но Enter не срабатывает
(setq *MIP-MODEMACRO-SCALE*  (getreal (strcat "\nТекущий масштабный коэффициент<" (rtos *MIP-MODEMACRO-SCALE* 2 2) ">: "))
(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) 
)

Последний раз редактировалось Loolik, 23.04.2018 в 11:25.
Loolik вне форума  
 
Непрочитано 23.04.2018, 11:38
#197
Sinmad


 
Регистрация: 13.12.2017
Абакан
Сообщений: 2


GeomProps
Sinmad вне форума  
 
Непрочитано 23.04.2018, 11:41
#198
Loolik


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


Цитата:
Сообщение от Sinmad Посмотреть сообщение
GeomProps
О GeomProps конечно знаю, но хочу использовать в некоторых ситуациях ЛИСП.
Loolik вне форума  
 
Непрочитано 23.04.2018, 15:34
1 | #199
koMon


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


Цитата:
Сообщение от Loolik Посмотреть сообщение
чтобы при выполнении он вписывал существующее значение переменной, а при нажатии на Enter принимал это же значение
Код:
[Выделить все]
 
(initget 6)
;; Хочу получить переменную
(setq mmss t)
(while mmss 
	(setq *MIP-MODEMACRO-SCALE* (if (null (setq mms_temp (getreal (strcat "\nНовый масштабный коэффициент: <" (if *MIP-MODEMACRO-SCALE* (rtos *MIP-MODEMACRO-SCALE*) "") ">: ")))) 
									*MIP-MODEMACRO-SCALE*
									mms_temp
								)
		   mmss (if *MIP-MODEMACRO-SCALE* nil t)
	)
)

Последний раз редактировалось koMon, 23.04.2018 в 15:43.
koMon вне форума  
 
Непрочитано 24.04.2018, 00:55
#200
Loolik


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


Спасибо koMon, код работает!
Пытаюсь модифицировать ЛИСП из поста 104 и сделать две команды (но в идеале одну):
  1. Len2NT - задаю пользовательский коэффициент пересчета |-> выделяю геометрию для вычисления длины |-> вставляю новый текст в чертеж.
    Эта фукция работает.
  2. Len2ET - задаю пользовательский коэффициент пересчета |-> выделяю геометрию для вычисления длины |-> вставляю в существующий текст/ячейку таблицы в чертеж.
    Эта функция не работает для пустых ячеек таблиц.
  3. Len2TX - В идеале хочется такую команду - задаю пользовательский коэффициент пересчета |-> выделяю геометрию для вычисления длины |-> выбираю режим вставки результата (либо новый текст, либо изменить существующий).
Прошу помощи, как допилить код, чтобы результат вставлялся в пустую ячейку таблицы? При копипасте кода функции TTC_Paste из поста 162, работать программа отказалась.
Если есть возможность помогите с "однокомандной хотелкой" Len2TX .
Код:
[Выделить все]
 
(vl-load-com)
(if (null *MIP-MODEMACRO-HTXT*)
  (setq *MIP-MODEMACRO-HTXT* 300)
  ) ;_Высота текста
(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="
		     (rtos *MIP-MODEMACRO-SCALE* 2 2)
		     "\n Общая длина линейных примитивов: "
		     (rtos *MIP-LENGTH*
			   2
			   (if (< *MIP-MODEMACRO-RTOS* 0)
			     (getvar "LUPREC")
			     *MIP-MODEMACRO-RTOS*
			     ) ;_ конец if
			   ) ;_ конец rtos
		     ) ;_ strcat 
	     ) ;_ princ 
      ) ;_  progn 
    (alert "Примитивы не выбраны!")
    ) ;_  if 
  (prin1)
 ) ;_ конец defun entLen
  

(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)
    ) ;_ конец if
  (initget 4 "L")
  (princ "\nТочность округления [Luprec] <")
  (if (< *MIP-MODEMACRO-RTOS* 0)
    (princ "Luprec")
    (princ *MIP-MODEMACRO-RTOS*)
    ) ;_ конец if
  (princ ">: ")
  (if (setq buf (getint))
    (setq *MIP-MODEMACRO-RTOS*
	   (if (numberp buf)
	     buf
	     -1
	     ) ;_ конец if
	  ) ;_ конец setq
    ) ;_ конец if
  (vl-propagate '*MIP-MODEMACRO-HTXT*)
  (vl-propagate '*MIP-MODEMACRO-RTOS*)
  (vl-propagate '*MIP-MODEMACRO-SCALE*)
  (princ)
) ;_ конец defun MM

(defun TTC_Paste(pasteStr keepText / nslLst vlaObj )
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE


;;Length Print to Existing text
(defun c:LPE ( )
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." ","  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ)
) ;_ конец defun LPE
  

;;Length Print to New text
(defun c:LPN  ()
  (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*
		  ) ;_ конец if
		) ;_ конец rtos
	  ) ;_ конец vl-string-translate
	(vlax-3d-point '(0 0 0))
	*MIP-MODEMACRO-HTXT*
	) ;_ конец vla-addtext
      (princ "\n Укажите точку вставки текста:")
      (command "_.copybase" '(0 0 0) (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause)
      ) ;_ конец progn
    ) ;_ конец if
  (princ)
  ) ;_ конец defun
;;(princ "\nНаберите в командной строке:
;;          \nEntLen - подсчет примитивов
;;          \nMM - масштабный коэффициент и настройка
;;          \nLPN - результат в новый текст
;;          \nLPE - результат в существующий текст")
;;(princ)

;;Команда вставки нового текста с результатом вычислений суммы примитивов
;;с преварительным указанием масштабного коэффициента

(defun c:Len2NT	 ()
  (initget 6)
  (setq mmss t)
  (while mmss
    (setq *MIP-MODEMACRO-SCALE*
	   (if (null (setq mms_temp (getreal (strcat "\nНовый масштабный коэффициент: <"
						     (if *MIP-MODEMACRO-SCALE*
						       (rtos *MIP-MODEMACRO-SCALE*)
						       ""
						       ) ;_ конец if
						     ">: "
						     ) ;_ конец strcat
					     ) ;_ конец getreal
			   ) ;_ конец setq
		     ) ;_ конец null
	     *MIP-MODEMACRO-SCALE*
	     mms_temp
	     ) ;_ конец if
	  mmss (if *MIP-MODEMACRO-SCALE*
		 nil
		 t
		 ) ;_ конец if
	  ) ;_ конец setq
    ) ;_ конец while
  (C:ENTLEN)
  (C:LPN)
  ) ;_ конец defun Len2NT
  
;;Команда вставки в существующий текст результата вычислений суммы примитивов
;;с преварительным указанием масштабного коэффициента
(defun c:Len2ET	 ()
  (initget 6)
  (setq mmss t)
  (while mmss
    (setq *MIP-MODEMACRO-SCALE*
	   (if (null (setq mms_temp (getreal (strcat "\nНовый масштабный коэффициент: <"
						     (if *MIP-MODEMACRO-SCALE*
						       (rtos *MIP-MODEMACRO-SCALE*)
						       ""
						       ) ;_ конец if
						     ">: "
						     ) ;_ конец strcat
					     ) ;_ конец getreal
			   ) ;_ конец setq
		     ) ;_ конец null
	     *MIP-MODEMACRO-SCALE*
	     mms_temp
	     ) ;_ конец if
	  mmss (if *MIP-MODEMACRO-SCALE*
		 nil
		 t
		 ) ;_ конец if
	  ) ;_ конец setq
    ) ;_ конец while
  (C:ENTLEN)
  (C:LPE)
  ) ;_ конец defun Len2ET

Последний раз редактировалось Loolik, 24.04.2018 в 01:01.
Loolik вне форума  
 
Непрочитано 24.04.2018, 21:38
#201
koMon


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


Loolik, если коротенько обобщить, то длину каких примитивов нужно считать и в какие вставлять? По мне, так лучше выстругать новые грабли)
koMon вне форума  
 
Непрочитано 25.04.2018, 10:06
#202
Loolik


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


koMon, постараюсь перефразировать)
Собственно, взят код из поста 104.
Добавляю в конце команду:
Len2ET - вставка результата функции EntLen в существующий Текст/МТекст/Ячейку таблицы/Атрибут/МВыноску. Эта команда работает как положено, за исключением вставки текста в ячейку таблицы с пустым текстом. Своими силами исправить ошибку не смогу


Код:
[Выделить все]
 
;;Команда вставки в существующий текст результата вычислений суммы примитивов
;;с преварительным указанием масштабного коэффициента
(defun c:Len2ET	 ()
  (initget 6)
  (setq mmss t)
  (while mmss
    (setq *MIP-MODEMACRO-SCALE*
	   (if (null (setq mms_temp (getreal (strcat "\nНовый масштабный коэффициент: <"
						     (if *MIP-MODEMACRO-SCALE*
						       (rtos *MIP-MODEMACRO-SCALE*)
						       ""
						       ) ;_ конец if
						     ">: "
						     ) ;_ конец strcat
					     ) ;_ конец getreal
			   ) ;_ конец setq
		     ) ;_ конец null
	     *MIP-MODEMACRO-SCALE*
	     mms_temp
	     ) ;_ конец if
	  mmss (if *MIP-MODEMACRO-SCALE*
		 nil
		 t
		 ) ;_ конец if
	  ) ;_ конец setq
    ) ;_ конец while
  (C:ENTLEN)
  (C:LPE)
  ) ;_ конец defun Len2ET

Интуитивно понимаю, что не работает эта часть кода

Код:
[Выделить все]
 
(defun TTC_Paste(pasteStr keepText / nslLst vlaObj )
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE


;;Length Print to Existing text
(defun c:LPE ( )
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." ","  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ)
) ;_ конец defun LPE
  
Loolik вне форума  
 
Непрочитано 25.04.2018, 11:13
#203
koMon


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


Вот. Вы Entlen-ом суммарную длину каких-то определённых примитивов считаете, ну там отрезок, полилиния..? Потому как Entlen из #104, по ходу, будет считать всё, что считается.
koMon вне форума  
 
Непрочитано 25.04.2018, 11:31
#204
Loolik


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Потому как Entlen из #104, по ходу, будет считать всё, что считается.
Именно это и нужно - считать всю возможную геометрию (полилинии, сплайны, дуги, отрезки, окружности). Чертежи могут оказаться чужими, а разбираться какими примитивами вычерчено не очень хочется.
Loolik вне форума  
 
Непрочитано 25.04.2018, 12:13
1 | #205
VVA

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


Цитата:
Сообщение от Loolik Посмотреть сообщение
Интуитивно понимаю, что не работает эта часть кода
Добавлена опция "Точка"
Код:
[Выделить все]
(defun TTC_Paste(pasteStr keepText / nslLst vlaObj tstyle txt pt tblobj lst tblset row col )
 ;;; keepText - t  -  сохранить текст
 ;;;         - nil - заменить текст
 ;;;         - "Точка" - вставить в ячейку таблицы
(if (eq keepText  "Точка")(setq nslLst keepText keepText nil))
(or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
(initget "Точка")
(if (or (eq nslLst "Точка")
        (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки [Точка для пустой ячейки] <выход>: "))
        )
(progn (cond
((eq nslLst "Точка")
 (setvar "cmdecho" 0)
(setq tstyle (getvar "TEXTSTYLE")) ;_Стиль текста Стиль должен существовать
    ;_ Создаем текст
(if (= (cdr (assoc 40 (tblsearch "STYLE" tstyle))) 0.0)
     ;; нулевая высота текста
   (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) *TEXTSIZE* 0 pasteStr)
   (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) 0 pasteStr)
   ) ;_ end of if
    (setq txt (entlast))
  ;_ Копируем в буфер и обратно
  (vl-cmdf "_updatefield" txt "")
  (princ "\n Укажите точку вставки текста или ячейку таблицы:")
  (vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
  ;_ В txt примитив текста в pt точка вставки  
  (setq txt (entlast) pt (getvar "LASTPOINT"))
(or
    (and ;_Проверяем, попала ли точка в ячейку таблицы
      (setq  tblobj nil tblset (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
      (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (progn
        (vl-catch-all-apply '(lambda()
        (mapcar '(lambda (x)
           (or tblobj
               (and
                 (= :vlax-true (vla-HitTest x
                               (vlax-3d-point (trans pt 1 0))
                               (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                               'row 'col))
                 (setq tblobj x)
                 )
               )
           )
        lst)
                               )
          )
        tblobj
        )
       row col
      (or (vla-SetText tblobj row col pasteStr) t)
      (entdel txt)
      )
    (and ;_Не попала, рисуем текст с полем
      (setq txt (vlax-ename->vla-object txt))
      (vlax-write-enabled-p txt)
      (vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
      (vlax-property-available-p txt 'TextString)
      (vlax-put txt 'TextString pasteStr)
      )
    )
  )         
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF" "MULTILEADER"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. "))); end condition #4

(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 27.04.2018 в 10:55. Причина: Добавлена мультивыноска ("MULTILEADER")
VVA вне форума  
 
Непрочитано 25.04.2018, 13:07
#206
Loolik


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Добавлена опция "Точка"
Спасибо, но результат выполнения "Точка для пустой ячейки" создает новый текстовый примитив.
А возможно реализовать вставку текста именно в пустую ячейку таблицы, причем без дополнительного выбора в контекстном меню? Т.е. чтобы TTC_Paste понимала, что я выбрал либо текстосодержащий объект (МТекст, Текст, Артибут, ЯчейкуТаблицыСТекстом), либо ПустуюЯчейкуТаблицы?
Loolik вне форума  
 
Непрочитано 25.04.2018, 14:06
#207
VVA

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


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

Цитата:
Сообщение от Loolik Посмотреть сообщение
Точка для пустой ячейки" создает новый текстовый примитив
Ну так и ткни им в пустую ячейку и посмотри на результат
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.04.2018, 14:19
#208
Loolik


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Ну так и ткни им в пустую ячейку и посмотри на результат
Происходит создание текста поверх таблицы. В содержимое ячейки ничего не вписывается. Проверял на AutoCAD 2009x86, AutoCAD 2015x64.

Последний раз редактировалось Loolik, 25.04.2018 в 14:27.
Loolik вне форума  
 
Непрочитано 25.04.2018, 16:55
1 | #209
VVA

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


Цитата:
Сообщение от Loolik Посмотреть сообщение
Происходит создание текста поверх таблицы.
Исправил #205
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 26.04.2018, 17:45
#210
Loolik


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


VVA, спасибо за помощь, работает отлично.
Осталась последняя хотелка, но затыкаюсь в одном месте.
Программингом не владею, делаю свою команду по подобию, которая будет делать следующее:
  1. Задаю пользовательский масштабный коэффициент
  2. Выполняю подсчет длин примитивов
  3. Указываю на выбор режим вставки результата /Новый текст/Существующий текст/Пустая ячейка таблицы/
Так вот затык получается при попытке выполнить вставку в пустую ячейку
Код:
[Выделить все]
(COMMAND (c:LPE) "_Точка")

Код:
[Выделить все]
(defun c:Len2TX1 (/ *ans* )
   ;; Задаем пользовательский масштабный коэффициент:
   (initget 6)
   (setq mmss t)
   (while mmss
      (setq *MIP-MODEMACRO-SCALE*
         (if (null 
               (setq mms_temp 
                  (getreal
                     (strcat "\nНовый масштабный коэффициент: <"
                        (if *MIP-MODEMACRO-SCALE* (rtos *MIP-MODEMACRO-SCALE*) "") ;_ конец if
                        ">: "
                     ) ;_ конец strcat
                  ) ;_ конец getreal
               ) ;_ конец setq
            ) ;_ конец null
            *MIP-MODEMACRO-SCALE* mms_temp
         ) ;_ конец if
         mmss (if *MIP-MODEMACRO-SCALE* nil t) ;_ конец if
      ) ;_ конец setq
   ) ;_ конец while
   ;; Выполняем подсчет длин примитивов
   (C:ENTLEN)
   ;; Определяем тип вставки результата
   (initget "Новый Существующий ПустЯчейкаТаблицы")
   (setq *ans*
      (cond
        (
          (getkword
            (strcat "\nРезультат в /Новый Текст/Существующий Текст/Пустую Ячейку Таблицы/ [Новый/Существующий/ПустЯчейкаТаблицы]<"
              (setq *ans*
                (cond ( *ans* ) ( "Новый" ))
              ) ">: "
            )
          )
        )
      )
    )
    (if (= *ans* "Новый") (c:LPN)
        (if (= *ans* "Существующий") (c:LPE) 
            (COMMAND (c:LPE) "_Точка")
        )
    )
) ; конец defun c:Len2TX1
Loolik вне форума  
 
Непрочитано 26.04.2018, 18:12
1 | #211
VVA

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


Loolik, Так не пойдет. Я обновил #205 еще раз. Добавил возможность передать параметр "Точка" (почитай коментарии в начале)
Соответственно для вставки в ячейку таблицы своя команда
Код:
[Выделить все]
;;Length Print to Table sell
(defun c:LPT ( )
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." ","  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 "Точка"))
(princ))
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.04.2018, 00:20
#212
Loolik


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Я обновил #205 еще раз. Добавил возможность передать параметр "Точка" (почитай коментарии в начале)
Соответственно для вставки в ячейку таблицы своя команда
Огромное спасибо за помощь, все работает отлично! А вставка в МВыноску по умолчанию не предусмотрена? В принципе, это мне и не требуется.
Вдруг кому пригодится результат - запускать командой LEN2TX
Код:
[Выделить все]
(vl-load-com)
;;Задание глобальных переменных с параметрами вставки текста
(if (null *MIP-MODEMACRO-HTXT*) (setq *MIP-MODEMACRO-HTXT* 300)) ;_Высота текста 300 единиц
(if (null *MIP-MODEMACRO-RTOS*) (setq *MIP-MODEMACRO-RTOS* -1.0)) ;_Округление -1-LUPREC
(if (null *MIP-MODEMACRO-SCALE*) (setq *MIP-MODEMACRO-SCALE* 1)) ;_Масштабный коэффициент 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-curve-getendparam (ssname set:entities int:l)))) ;_  + 
          ) ;_  конец 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="
          (rtos *MIP-MODEMACRO-SCALE* 2 2)
          "\n Общая длина линейных примитивов: "
          (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0) (getvar "LUPREC") *MIP-MODEMACRO-RTOS*) ;_ конец if
           ) ;_ конец rtos
        ) ;_ конец strcat 
      ) ;_ princ 
    ) ;_  progn 
    (alert "Примитивы не выбраны! Будет использован последний результат")
  ) ;_  if 
  (prin1)
) ;_ конец defun entLen


;;Задание глобальных переменных 
(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)
  ) ;_ конец if
  ;;Точность округления
  (initget 4 "L")
  (princ "\nТочность округления [Luprec] <")
  (if (< *MIP-MODEMACRO-RTOS* 0)
    (princ "Luprec")
    (princ *MIP-MODEMACRO-RTOS*)
  ) ;_ конец if
  (princ ">: ")
  (if (setq buf (getint))
    (setq *MIP-MODEMACRO-RTOS*
      (if (numberp buf)
        buf
        -1
      ) ;_ конец if
    ) ;_ конец setq
  ) ;_ конец if
  (vl-propagate '*MIP-MODEMACRO-HTXT*)
  (vl-propagate '*MIP-MODEMACRO-RTOS*)
  (vl-propagate '*MIP-MODEMACRO-SCALE*)
  (princ)
) ;_ конец defun MM

;;Вставка результата в текст или таблицу
(defun TTC_Paste (pasteStr keepText / nslLst vlaObj tstyle txt pt tblobj lst tblset row col )
;; keepText - t  -  сохранить текст
;;         - nil - заменить текст
;;         - "Точка" - вставить в ячейку таблицы
  (if (eq keepText  "Точка")
    (setq nslLst keepText keepText nil)
  );_ конец if
  (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (initget "Точка")
  (if 
    (or (eq nslLst "Точка")
      (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки [Точка для пустой ячейки] <выход>: "))
    )
    (progn 
      (cond
      ;  start condition #1
        (
          (eq nslLst "Точка")
          (setvar "cmdecho" 0)
          (setq tstyle (getvar "TEXTSTYLE")) ;_Стиль текста Стиль должен существовать
          ;_ Создаем текст
          (if (= (cdr (assoc 40 (tblsearch "STYLE" tstyle))) 0.0)
            ;; нулевая высота текста
            (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) *TEXTSIZE* 0 pasteStr)
            (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) 0 pasteStr)
          ) ;_ end of if
          (setq txt (entlast))
          ;_ Копируем в буфер и обратно
          (vl-cmdf "_updatefield" txt "")
          (princ "\n Укажите точку вставки текста или ячейку таблицы:")
          (vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
          ;_ В txt примитив текста в pt точка вставки  
          (setq txt (entlast) pt (getvar "LASTPOINT"))
          (or
            (and ;_Проверяем, попала ли точка в ячейку таблицы
              (setq  tblobj nil tblset (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
              (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
              (progn
                (vl-catch-all-apply 
                  '(lambda()
                    (mapcar 
                      '(lambda (x)
                        (or tblobj
                          (and
                            (= :vlax-true 
                              (vla-HitTest x
                                (vlax-3d-point (trans pt 1 0))
                                (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                                'row 'col
                              )
                            )
                            (setq tblobj x)
                          )
                        )
                      )
                      lst
                    )
                  )
                )
                tblobj
              ) ; end progn
              row col
              (or (vla-SetText tblobj row col pasteStr) t)
              (entdel txt)
            ) ; end and
            (and ;_Не попала, рисуем текст с полем
              (setq txt (vlax-ename->vla-object txt))
              (vlax-write-enabled-p txt)
              (vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
              (vlax-property-available-p txt 'TextString)
              (vlax-put txt 'TextString pasteStr)
            ) ; end and
          ) ; end or
        ) ; end condition #1

        ; start condition #2
        (
          (and (= 4 (length nslLst))
            (= "DIMENSION" (cdr(assoc 0(entget(car(last nslLst))))))
          ); end and
          (setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
          (setq oldStat (vla-get-Measurement vlaObj))
          (if keepText
            (if (= (vla-get-TextOverride vlaObj) "")
            (setq pasteStr (strcat
              pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) 
              (vla-get-PrimaryUnitsPrecision vlaObj)))
            ) ; end setq
            (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj))))
          ) ; end if
          (if 
            (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
            (princ "\n Can't paste. Object may be on locked layer. ")
          ) ; end if
        ); end condition #2

        ; start condition #3
        (
          (and (= 4(length nslLst))
            (= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))
          ); end and
          (setq vlaObj (vlax-ename->vla-object(car nslLst)))
          (if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
          (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
            (princ "\nError. Can't pase text. ") (entupd (car(last nslLst)))
          ) ; end if
        ); end condition # 3

        ; start condition #4
        (
          (and (= 4(length nslLst))
            (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))
          ); end and
          (princ "\nCan't paste to block's DText or MText. ")
        ); end condition #4

        ; start condition #5
        (
          (and (= 2(length nslLst))
            (member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF" "MULTILEADER"))
          ); end and
          (setq vlaObj (vlax-ename->vla-object(car nslLst)))
          (if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
          (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
            (princ "\nError. Can't pase text. ")
          ) ; end if
        ); end condition #5

        ; start condition #6
        (T (princ "\nCan't paste. Invalid object. ")); end condition #6
      ); end cond
    T); end progn
  nil); end if
);_TTC_PASTE


;;Length Print to Existing text
(defun c:LPE ( )
  (and (= (type *MIP-LENGTH*) 'REAL)
    (TTC_Paste 
      (vl-string-translate "." "," 
        (rtos *MIP-LENGTH* 2
          (if (< *MIP-MODEMACRO-RTOS* 0)
            (getvar "LUPREC")
            *MIP-MODEMACRO-RTOS*
          )
        )
      )
      nil
    )
  )
  (princ)
) ;_ конец defun LPE
  

;;Length Print to New text
(defun c:LPN  ()
  (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*
            ) ;_ конец if
          ) ;_ конец rtos
        ) ;_ конец vl-string-translate
       (vlax-3d-point '(0 0 0))
       *MIP-MODEMACRO-HTXT*
      ) ;_ конец vla-addtext
      (princ "\n Укажите точку вставки текста:")
      (command "_.copybase" '(0 0 0) (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause)
      ) ;_ конец progn
    ) ;_ конец if
  (princ)
) ;_ конец defun LPN


;;Length Print to Table sell
(defun c:LPT ( )
  (and (= (type *MIP-LENGTH*) 'REAL)
    (TTC_Paste (vl-string-translate "." ","  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUP