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

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

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

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

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

Полилиния не подходит т.к. эти отрезки разбросаны по всему чертежу, а надобы выбрав несколько линий узнать их общую длинну.
Просмотров: 140319
 
Непрочитано 28.04.2008, 11:37
#101
skkkk


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


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


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


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

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


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


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

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


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


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,990
<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


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


Спасибо,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


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


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,990
<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


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


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

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


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


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


Можно ли как-нибудь вот эти действия заставить выполняться посредством лиспа, а не из командной строки:
Код:
[Выделить все]
^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,840


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


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


Дима_, с этим:
Цитата:
В лиспе это выглядит (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


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


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


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


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


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,990
<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


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


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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<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 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен LISP для суммы длин отрезков линни

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

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