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

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

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

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

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

Полилиния не подходит т.к. эти отрезки разбросаны по всему чертежу, а надобы выбрав несколько линий узнать их общую длинну.
Просмотров: 140330
 
Непрочитано 25.05.2017, 12:48
#181
skkkk


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


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


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


По-моему, что-то вы перемудрили. Исходная задача какая: есть единая полилиния рельефа, и надо записать в графе профиля расстояния по ней с определённым шагом по пикетажу. Это можно сделать в одном цикле, и не надо ничего рвать и выбирать каждый раз новую полилинию. Направление исходной, конечно, надо проверить.
В общем, какой-то такой функционал получается:
Код:
[Выделить все]
 (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


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


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

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


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


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


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


Да, выход из цикла у меня получился с ошибкой (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


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


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


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


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

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


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


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


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

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


Здесь уже ничего - не станешь же фильтровать посты...
А так - сумма длин кривых и расстановка текста разные задачи. Создай новую тему, задай там вопрос, упомяни, что "начало обсуждения там-то, создал отдельную тему по просьбе модератора" - и все будет хорошо.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.06.2017, 08:27
#191
Рyslan


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


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


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


Уважаемые гуру! Можно ли отредактировать код из поста 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
С.-Петербург
Сообщений: 39,772


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


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


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


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


Цитата:
Чем отличается сумма значений длин сегментов полилинии от ее общей длины?
округлением
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
Абакан
Сообщений: 3


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
Сообщений: 1,664


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

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

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