[bdfy]

Как узнать длинну всех выделенных линий ? Есть схемка электросети ( натурально сетка из 2-3 неправильной формы ячеек, бывает не замкнутые ), линии ее образующие все прямые - Мне надо длинну общую всех линий узнать. Как ? length команды нет, area это не то, perimeter тоже... есть ведь команда наверное, подскажите .

[kha]

учитесь пользоваться поиском по форуму, тема уже поднималась

Сообщение от Profan Можно здесь посмотреть: http://dwg.ru/forum/viewtopic.php?t=953& И здесь: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=20211Ym И еще, наверное, есть куча готовых программ.

[bdfy]

ОК. с этим ясно. ( я в поиск похоже "длинна" вбивал, вот и не нашел )
Другая задача: надписать размер всех линий (каждой в отдельности ) сверху (т.е над линией , паралельно ей ). Это реально ? чтоб размерных линий не было ?
Автопростановщики размеров конечно есть, но образмерят они ведь по госту , а не как мне надо

[DEM]

Скачай утилиту KitoX из Download

[VVA]

Есть интересное решение через реакторы. Длина выбранных элементов отражается в статусной строке.
Команды
VlrOn - включает реактор
VlrOFF - отключает реактор
MM - для указания масштабного коэффициента, высоты текста, точности округления
MC - для (вдруг понадобится) очистки MODEMACRO
LP - печать полученного результата. Сам результат хранится в глобальной переменной *MIP-LENGTH*. Можно посмотреть, набрав !*MIP-LENGTH* в командной строке

Код:

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

; http://forum.dwg.ru/showthread.php?p=93365#post93365
;http://forum.dwg.ru/showthread.php?t=842&page=4
;http://www.cadtutor.net/forum/showthread.php?t=13950
;VlrOn - включает реактор
;VlrOFF - отключает реактор
;MM -  для указания масштабного коэффициента, высоты текста, точности округления
;MC - для (вдруг понадобится) очистки MODEMACRO
;LP - печать полученного результата
(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
(VL-PROPAGATE '*MIP-MODEMACRO-HTXT*)
(VL-PROPAGATE '*MIP-MODEMACRO-RTOS*)

;;=============== Реакторы =======================
(defun C:VlrOFF ()
      (setq *vlr-mis* nil) 
    (vlr-remove-all :vlr-miscellaneous-reactor)
  (setvar "modemacro" (if (= (type *MIP-MODEMACRO-OLD*) 'STR) *MIP-MODEMACRO-OLD* ""))
  (princ "\nРеактор длинны отключен")(princ)
  )
(defun C:VlrOn ( )
(if *vlr-mis* 
  (progn 
    (setq *vlr-mis* nil) 
    (vlr-remove-all :vlr-miscellaneous-reactor))) 
(if (not *vlr-mis*) 
  (setq   *vlr-mis* (vlr-miscellaneous-reactor 
          (list '("Rname" "MipSelChange")) 
          '((:vlr-pickfirstmodified . selchange)))))
  (princ "\nРеактор длинны включен")(princ)
  )

(defun selchange (reactor event / selset sum_len item_name nstyle err len ent ds)
  (if (and (VLR-added-p reactor);_активизирован реактор
           (= (cadr(assoc "Rname" (vlr-data reactor))) "MipSelChange")
           )
    (progn 
  (if (null *MIP-MODEMACRO-OLD*)(setq *MIP-MODEMACRO-OLD* (getvar "MODEMACRO"))) 
  (setq sum_len 0.0)
  (setq err (vl-catch-all-apply '(lambda ()(and (setq selset   (vla-get-pickfirstselectionset 
           (vla-get-activedocument (vlax-get-acad-object))))
      (> (vla-get-count selset) 0)))))
  (if (and (not (vl-catch-all-error-p err))
	   err)
  (progn 
   (vlax-for   item selset
     (cond
       	 ((= (strcase (vla-get-objectname item)) "ACDBMLINE")
	  (setq ent (entget(vlax-vla-object->ename item)))
	  (setq len (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 11 (car x)))) ent)))
	  (if (= 2 (logand 2 (cdr(assoc 71 ent))))(setq len (append len (list (car len)))))
	  (setq ds (car len))
          (setq sum_len (+ sum_len (apply '+ (mapcar '(lambda(x / dst)(setq dst (distance ds x))(setq ds x) dst) len))))
	 )
         ((vlax-property-available-p item 'length)
	    (setq sum_len (+ sum_len (if (vl-catch-all-error-p(vl-catch-all-apply '(lambda()(setq len (vla-get-length item))))) 0 len))))
	 ((member (setq item_name (strcase (vla-get-objectname item) t)) '("acdbcircle" "acdbarc" "acdbellipse" "acdbspline"))
            (setq sum_len (+ sum_len 
                            (cond ((= item_name "acdbcircle")(* 2 pi (vla-get-radius item))) 
                                  ((= item_name "acdbarc")(vla-get-ArcLength item))
                                  ((member item_name '("acdbellipse" "acdbspline")) 
                                    (vlax-curve-getDistAtParam item (vlax-curve-getEndParam item)))
		                  (t 0.0))))
	  )
	 (t nil)
	   )
   ) ;_ end of vlax-for 
   (if (member (type *MIP-MODEMACRO-SCALE*) '(INT REAL)) 
   (progn 
   (setq item_name (strcat " (K=" (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*) ")")) 
   (setq sum_len (* sum_len *MIP-MODEMACRO-SCALE*)) 
   ) 
   (setq item_name " (K=1)" *MIP-MODEMACRO-SCALE* 1) 
   )
   (setq *MIP-LENGTH* sum_len)
      (setvar "modemacro" (strcat "Выбрано="
				  (itoa (vla-get-count selset))
				  " Длина="
				  (rtos sum_len 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))
				  (strcat item_name " MM-масштаб LP-печать")))
      ) ;_ end of progn 
     (progn
      (setvar "modemacro" (if (= (type *MIP-MODEMACRO-OLD*) 'STR) *MIP-MODEMACRO-OLD* ""))
      (if (wcmatch (getvar "modemacro") "Выбрано=*")(setvar "modemacro" ""))
      (setq *MIP-MODEMACRO-OLD* nil)
      )
    )
      )))
(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:MC ()(setvar "modemacro" "")(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))

Вариант без реакторов

[taras]

Утилита Vetcad

[Zouss]

мои 16 копеек:
http://dwg.ru/forum/viewtopic.php?p=...ghlight=#73326

[VVA]

>Zouss Я этот вариант и показал в посте №5,только добавлены еще сплайны и эллипсы и восстановление предыдущего состояния MODEMACRO. Добавлена возможность использовать масштабный коэффициент.

[Zouss]

звиняйте тормозю...

не из вредности, а усовершенствования для - modemacro не восстанавливается, а обнуляется

[VVA]

>ZoussДавай разбираться
1.Начинаем новый рисунок.
2. Рисуем пару линий
3.Грузим код
4.В ком. строке MODEMACRO - значение TEST
5.Выделяем отрезки смотрим статусную строку
6.Жмем ESC смотрим статусную строку
7.Что видим?

Команда MC очистит MODEMACRO

[Zouss]

Сообщение от VVA Команда MC очистит MODEMACRO

ну а я про что - именно очистит... а ежели у меня там уже чево-то было?
кроме того у начинающих, в смысле если acad без аэродинамического обвеса там без кенгурятников и светодиодов прога и не сработает ибо (vl-load-com) в начале нету

[bdfy]

Скачай утилиту KitoX из Download

В инфотулз там можно только инфу по одному обьекту вывести за один клик. да и инфа паралельно оси Х, а не образмериваемой линии. так что не подходит.
VVA

Длина выбранных элементов отражается в статусной строке

а мне их надо нанести на схему.

Утилита Vetcad

А это вообще к чему ? не вижу там подобных возможностей.

[VVA]

а ежели у меня там уже чево-то было?

Дык ты ее не вызывай, это для тех, кто не знает про MODEMACRO, да и MC набрать быстрее.
Реакторы должны когда выбраны объеты показать длину, а когда нет восстановить пред. значение modemacro.
(vl-load-com) - постоянно забываю. У меня грузится автоматом.
Скорее всего ты прав - в MC - надо сделать запрос.

Код:

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

(vl-load-com)
(if *vlr-obj* 
  (progn 
    (setq *vlr-obj* nil) 
    (vlr-remove-all :vlr-miscellaneous-reactor))) 
(if (not *vlr-obj*) 
  (setq   *vlr-obj* (vlr-miscellaneous-reactor 
          nil 
          '((:vlr-pickfirstmodified . selchange))))) 


(defun selchange (reactor event / selset sum_len item_name) 
  (if (null *MIP-MODEMACRO-OLD*)(setq *MIP-MODEMACRO-OLD* (getvar "MODEMACRO"))) 
  (setq sum_len 0.0) 
  (if (and (setq selset   (vla-get-pickfirstselectionset 
           (vla-get-activedocument (vlax-get-acad-object)))) 
      (> (vla-get-count selset) 0)) 
  (progn 
   (vlax-for   item selset 
   (if (vlax-property-available-p item 'length) 
     (setq sum_len (+ sum_len (vla-get-length item))) 
     (setq   item_name (strcase (vla-get-objectname item) t) 
      sum_len (+ sum_len 
   (cond ((= item_name "acdbcircle")(* 2 pi (vla-get-radius item))) 
         ((= item_name "acdbarc")(vla-get-ArcLength item)) 
         ((member item_name '("acdbellipse" "acdbspline")) 
          (vlax-curve-getDistAtParam item (vlax-curve-getEndParam item))) 
         (t 0.0)))) 
     ) ;_ end of if 
   ) ;_ end of vlax-for 
   (if (member (type *MIP-MODEMACRO-SCALE*) '(INT REAL)) 
   (progn 
   (setq item_name (strcat " (K=" (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*) ")")) 
   (setq sum_len (* sum_len *MIP-MODEMACRO-SCALE*)) 
   ) 
   (setq item_name " (K=1)" *MIP-MODEMACRO-SCALE* 1) 
   ) 
      (setvar "modemacro" (strcat "Выбрано=" (itoa (vla-get-count selset)) " Длина=" (rtos sum_len 2 4) (strcat item_name " MM-изм. масштаб"))) 
      ) ;_ end of progn 
     (progn 
      (setvar "modemacro" (if (= (type *MIP-MODEMACRO-OLD*) 'STR) *MIP-MODEMACRO-OLD* "")) 
      (setq *MIP-MODEMACRO-OLD* nil) 
      ) 
    ) ;_ end of if 
  ) ;_ end of defun 
(defun c:MM ( ) 
  (initget 7) 
  (setq *MIP-MODEMACRO-SCALE* (getint "\nНовый масштабный коэффициент: "))(princ)) 
(defun C:MC ( / str)
  (princ "\nНовое значение MODEMACRO <")
  (princ (getvar "MODEMACRO"))
  (princ ">: ")
  (setq str (getstring t))
  (if (= str "")(setq str (getvar "MODEMACRO")))
  (setvar "modemacro" str)(princ))

И для начинающих Как сохранить программный код на своем компьютере?

[VVA]

а мне их надо нанести на схему

А вначале то было

Как узнать длинну всех выделенных линий ?

Узнать и нанести немного разные вещи :wink: :wink:

Код:

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

(vl-load-com)
(if *vlr-obj* 
  (progn 
    (setq *vlr-obj* nil) 
    (vlr-remove-all :vlr-miscellaneous-reactor))) 
(if (not *vlr-obj*) 
  (setq   *vlr-obj* (vlr-miscellaneous-reactor 
          nil 
          '((:vlr-pickfirstmodified . selchange))))) 


(defun selchange (reactor event / selset sum_len item_name) 
  (if (null *MIP-MODEMACRO-OLD*)(setq *MIP-MODEMACRO-OLD* (getvar "MODEMACRO"))) 
  (setq sum_len 0.0) 
  (if (and (setq selset   (vla-get-pickfirstselectionset 
           (vla-get-activedocument (vlax-get-acad-object)))) 
      (> (vla-get-count selset) 0)) 
  (progn 
   (vlax-for   item selset 
   (if (vlax-property-available-p item 'length) 
     (setq sum_len (+ sum_len (vla-get-length item))) 
     (setq   item_name (strcase (vla-get-objectname item) t) 
      sum_len (+ sum_len 
   (cond ((= item_name "acdbcircle")(* 2 pi (vla-get-radius item))) 
         ((= item_name "acdbarc")(vla-get-ArcLength item)) 
         ((member item_name '("acdbellipse" "acdbspline")) 
          (vlax-curve-getDistAtParam item (vlax-curve-getEndParam item))) 
         (t 0.0)))) 
     ) ;_ end of if 
   ) ;_ end of vlax-for 
   (if (member (type *MIP-MODEMACRO-SCALE*) '(INT REAL)) 
   (progn 
   (setq item_name (strcat " (K=" (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*) ")")) 
   (setq sum_len (* sum_len *MIP-MODEMACRO-SCALE*)) 
   ) 
   (setq item_name " (K=1)" *MIP-MODEMACRO-SCALE* 1) 
   ) 
      (setvar "modemacro" (strcat "Выбрано=" (itoa (vla-get-count selset)) " Длина=" (rtos sum_len 2 4) (strcat item_name " MM-изм. масштаб")))
      (setq *MIP-LENGTH* sum_len)
      ) ;_ end of progn 
     (progn 
      (setvar "modemacro" (if (= (type *MIP-MODEMACRO-OLD*) 'STR) *MIP-MODEMACRO-OLD* "")) 
      (setq *MIP-MODEMACRO-OLD* nil) 
      ) 
    ) ;_ end of if 
  ) ;_ end of defun 
(defun c:MM ( ) 
  (initget 7) 
  (setq *MIP-MODEMACRO-SCALE* (getint "\nНовый масштабный коэффициент: "))(princ)) 
(defun C:MC ( / str)
  (princ "\nНовое значение MODEMACRO <")
  (princ (getvar "MODEMACRO"))
  (princ ">: ")
  (setq str (getstring t))
  (if (= str "")(setq str (getvar "MODEMACRO")))
  (setvar "modemacro" str)(princ))
(defun c:LP ( / dat pt old_cmd osm *error*) 
 (defun *error* (msg)(princ msg)(setvar "OSMODE" osm)) 
 (setq old_cmd  (getvar "CMDECHO") 
           osm  (getvar "OSMODE")) 
 (setvar "CMDECHO" 0) 
 (setq dat *MIP-LENGTH*)
 (if (numberp dat )
   (progn
     (initget 1)
 (setq dat (rtos dat 2 4)
        pt (getpoint "\nТочка вставки текста: ")) 
 (setvar "OSMODE" 0) 
(if (zerop (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))) 
     ;; нулевая высота текста 
      (COMMAND "_TEXT" pt 3.0 0 dat) 
     ;; фиксированнная высота 
      (COMMAND "_TEXT" pt 0 dat))
 ;;;Высота 3 ===== 
 (setq strok (entget(entlast))) 
 (setq strok (subst (cons 40 3.0)(assoc 40 strok) strok)) 
 (entmod strok)
     ))
 ;;;======  
 (setvar "CMDECHO" old_cmd) 
 (setvar "OSMODE" osm) 
 (princ) 
)

Здесь добавлена команда LP(Length Print). После того как в статусной строке увидел нужное число. Набери в ком. строке LP

[bdfy]

Узнать и нанести немного разные вещи

правильно. как узнать разобрались после первого же поста. потом я вопрос поменял. ладно, в след. раз отдельную тему создам...

Здесь добавлена команда LP(Length Print)

Все хорошо, но прочитайте же мой второй пост

Другая задача: надписать размер всех линий (каждой в отдельности ) сверху (т.е над линией , паралельно ей ).

Спасибо вам конечно но вы совсем другую задачу решили (из первого поста).
Сами схемы выложу для примера. одна линия в самом низу там подписана. Вот надо так подписать все линии на всех схемах.
[ATTACH]1159266839.rar[/ATTACH]

[Zouss]

...разобрались после первого же поста. потом я вопрос поменял...

bdfy, ты настоящий заказчик

Автопростановщики размеров конечно есть, но образмерят они ведь по госту , а не как мне надо

предлагаю решение стандартными средствами - создаем размерный стиль с выключенными размерными и выносными линиями, расположением тескта всегда горизонтально и префиксом размерного числа L=. Далее выбираем _dimaligned, щелкаем правой кнопкой мыши или Enter, щелкаем отрезок, располагаем текст. Минус - только по одному объекту, столь нужная вам сумма не считается, зато как элегантно и связь с объектом имеется. А так попробуйте модифицировать любую из предложенных программ под себя - это легче чем кажется.

Про MC - я бы сохранял текущее значение modemacro в какой нибудь переменной, да хотя бы в Users3, а по MC восстанавливливал бы ее оттуда без спроса... никто бы ничево бы и не заметил бы

[bdfy]

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

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

Алгоритм то я себе примерно представляю, но в лиспе не знаю ни команд , ни главное синтаксиса языка
В цикле ( он и сейчас есть раз общую длинную считаем )
1. нашли линию, узнали длинну
2. нашли центр линии и ее направление.
3. перпендикулярно линии на нном удалении помещаем надпись с длинной.
Вроде ж просто ? как сделать ?

[Zouss]

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

[bdfy]

нного растояния - какое оно должно быть

к примеру одна третяя от размера текста.

[bdfy]

К слову все еще актуально
2VVA
Как размер шрифта покрутить в вашем лиспе я еще нашел, а вот где точность вывода (т.е число знаков после запятой ) крутнуть ?

[VVA]

Ищи

Код:

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

(rtos sum_len 2 4)

2 - десятичная система счисления 4- число знаков после запятой
Лучше заменить

Код:

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

(rtos sum_len 2 4)
(rtos dat 2 4)

на

Код:

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

(rtos sum_len 2 (getvar "LUPREC"))
(rtos dat 2 (getvar "LUPREC"))

Тогда округление будет зависить от системной переменной LUPREC

[Sergiy]

Сообщение от bdfy Как узнать длинну всех выделенных линий ? Есть схемка электросети ( натурально сетка из 2-3 неправильной формы ячеек, бывает не замкнутые ), линии ее образующие все прямые - Мне надо длинну общую всех линий узнать. Как ? length команды нет, area это не то, perimeter тоже... есть ведь команда наверное, подскажите .

ToolPac->inquiry->distance->calculator->objects

[VVA]

Вот немного подравленные реакторы. Выяснилось что если среди выбранных объектов есть RTEXT, то конструкуция (vla-get-pickfirstselectionset (vla-get-activedocument (vlax-get-acad-object))) вылетает. Допускаю, что такое может быть и со сторонними объектами (например СПДС). Поэтому окружили ее оболочкой отлова ошибок. Теперь если такие объекты попались, то просто ничего не отобразиться в статусной строке. Точность округления, высота текста, масштабный коэффициент задаются в команде MM

Код:

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

(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
(VL-PROPAGATE '*MIP-MODEMACRO-HTXT*)
(VL-PROPAGATE '*MIP-MODEMACRO-RTOS*)
;;=============== Реакторы ======================= 
(if *vlr-mis* 
  (progn (setq *vlr-mis* nil)(vlr-remove-all :vlr-miscellaneous-reactor)))
(if (not *vlr-mis*)
  (setq   *vlr-mis* (vlr-miscellaneous-reactor nil 
          '((:vlr-pickfirstmodified . selchange))))) 
(defun selchange (reactor event / selset sum_len item_name nstyle err) 
  (if (null *MIP-MODEMACRO-OLD*)(setq *MIP-MODEMACRO-OLD* (getvar "MODEMACRO"))) 
  (setq sum_len 0.0)
  (setq err (vl-catch-all-apply '(lambda ()(and (setq selset   (vla-get-pickfirstselectionset 
           (vla-get-activedocument (vlax-get-acad-object))))
      (> (vla-get-count selset) 0)))))
  (if (and (not (vl-catch-all-error-p err)) err)
  (progn (vlax-for   item selset
   (if (vlax-property-available-p item 'length) 
     (setq sum_len (+ sum_len (vla-get-length item))) 
     (setq   item_name (strcase (vla-get-objectname item) t) 
      sum_len (+ sum_len 
   (cond ((= item_name "acdbcircle")(* 2 pi (vla-get-radius item))) 
         ((= item_name "acdbarc")(vla-get-ArcLength item)) 
         ((member item_name '("acdbellipse" "acdbspline")) 
          (vlax-curve-getDistAtParam item (vlax-curve-getEndParam item))) 
         (t 0.0))))))
   (if (member (type *MIP-MODEMACRO-SCALE*) '(INT REAL))(progn 
   (setq item_name (strcat " (K=" (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*) ")")) 
   (setq sum_len (* sum_len *MIP-MODEMACRO-SCALE*))) 
   (setq item_name " (K=1)" *MIP-MODEMACRO-SCALE* 1))
   (setq *MIP-LENGTH* sum_len)
   (setvar "modemacro" (strcat "Выбрано=" (itoa (vla-get-count selset)) " Длина="
                       (rtos sum_len 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))
                       (strcat item_name " MM-масштаб LP-печать"))))
    (progn (setvar "modemacro" (if (= (type *MIP-MODEMACRO-OLD*) 'STR) *MIP-MODEMACRO-OLD* "")) 
(setq *MIP-MODEMACRO-OLD* nil))))
(defun c:MM ( / buf )
  (initget 7)
  (setq *MIP-MODEMACRO-SCALE* (getint "\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:MC ()(setvar "modemacro" "")(princ))
(defun c:LP ( / txtpoint )(if (and (= (type *MIP-LENGTH*) 'REAL)
(setq txtpoint (getpoint "\n Введите точку вставки текста:")))
(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 (trans txtpoint 1 0)) *MIP-MODEMACRO-HTXT*))(princ))

[VVA]

К слову все еще актуально

А теперь

Код:

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

;;;Программа надписывает над отрезками их длинну
;;;Высота текста, отступ и точность округления берутся из текущего 
;;;размерного стиля (DIMTXT DIMGAP DIMDEC)
;;;Командная строка SL
(defun C:SL ( / ssline Htxt Ltxt Okr pt0 pt1 len ptc ang angtxt pttxt txt)
(vl-load-com) 
(setq ssline (ssget "_X" '((0 . "LINE"))))
(setq ssline (mapcar 'vlax-ename->vla-object(if ssline (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssline))) nil)))
(setq Htxt (getvar "DIMTXT")  ;_Высота текста
      Ltxt (getvar "DIMGAP")  ;_Отступ от размерной
      Okr  (getvar "DIMDEC")) ;_Точность округления
(foreach item ssline
  (setq pt0 (vlax-curve-getStartPoint item)
	pt1 (vlax-curve-getEndPoint item)
	len (vlax-curve-getEndParam item)
	ptc (vlax-curve-getPointAtParam item (* 0.5 len))
	ang (angle pt0 pt1)
     angtxt (cond ((and (>= ang 0)(<= ang (* 0.5001 pi)))  ang) ;_I четверть
		  ((and (> ang (* 0.5 pi))(<= ang (* 1.5001 pi)))(+ ang PI));_II и III четверть
		  (t ang));_IV четверть
	pttxt (polar ptc (if (equal ang angtxt 0.001)(+ ang (* 0.5 pi))(- ang (* 0.5 pi)))
		     Ltxt))
(setq txt (vla-addtext(vla-get-block(vla-get-ActiveLayout(vla-get-ActiveDocument(vlax-get-acad-object))))
(rtos len 2 Okr)(vlax-3d-point pttxt) HTXT))
(vla-put-Rotation txt angtxt)  
)
(princ)
)

[Zouss]

2 vva

(rtos sum_len 2 (getvar "LUPREC"))

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

(rtos sum_len 2)

результат будет тот же

[bdfy]

VVA
Прошу прощения что с некоторым опозданием отписываюсь. Отличный лисп подписывающий длинны, но пара вопросов.
Пробовал разобраться в этом примере - вопросы в коментах

Код:

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

;;задаем команду и список исп. переменных
(defun C:SL ( / ssline Htxt Ltxt Okr pt0 pt1 len ptc ang angtxt pttxt txt) 
(vl-load-com) 
;;я так понимаю ssline - это массив всех линий на чертеже , который мы здесь получаем ?
;;а как взять линии не со всего чертежа а с выдел. обл. только  ?
(setq ssline (ssget "_X" '((0 . "LINE")))) 
(setq ssline (mapcar 'vlax-ename->vla-object(if ssline (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssline))) nil))) 
(setq Htxt (getvar "DIMTXT")  ;_Высота текста 
      Ltxt (getvar "DIMGAP")  ;_Отступ от размерной 
      Okr  (getvar "DIMDEC")) ;_Точность округления 
;;Цикл над каждым элементом ssline
(foreach item ssline 
;; pt1,0 - коорд. концов , ptc коорд. центра
  (setq pt0 (vlax-curve-getStartPoint item) 
   pt1 (vlax-curve-getEndPoint item) 
   len (vlax-curve-getEndParam item) 
   ptc (vlax-curve-getPointAtParam item (* 0.5 len)) 
;;направление отрезка 
   ang (angle pt0 pt1) 
;;разворачиваем чтобы вверх ногами текста не было 
     angtxt (cond ((and (>= ang 0)(<= ang (* 0.5001 pi)))  ang) ;_I четверть 
        ((and (> ang (* 0.5 pi))(<= ang (* 1.5001 pi)))(+ ang PI));_II и III четверть 
        (t ang));_IV четверть 
;;задаем место текста учитываю отступ - 
   pttxt (polar ptc (if (equal ang angtxt 0.001)(+ ang (* 0.5 pi))(- ang (* 0.5 pi))) 
           Ltxt))
;;вот здесь бы смещ. отн. центра еще добавить...
;; в полярных коорд. угол (angtxt - pi), длинну смещения ну к примеру 1.5 высоты ( средн. надпись у меня 3-5 знака )
;;пробую вот так - результат такой же...
pttxt (polar pttxt (+ angtxt pi)  (* 1.5 Htxt) )
(setq txt (vla-addtext(vla-get-block(vla-get-ActiveLayout(vla-get-ActiveDocument(vlax-get-acad-object)))) 
(rtos len 2 Okr)(vlax-3d-point pttxt) HTXT)) 
(vla-put-Rotation txt angtxt)  
) 
(princ) 
)

1. надпись начинается от середины отрезка, т.е в итоге смещена отн. центра. т.е надо расчитать длинну надписи и сместить центра надписи отн. центра отрезка на половину этой длинны. Пробовал сам поправить , см. выше - не вышло
2. не могу понять как в строку вывода что-то дописать в конце - км к примеру.
3. приличный структурированный справочник по лисп командам где взять ? а то хелп на любую команду такой список разделов выдает...
4. и главное - как можно править лисп и проверять его в автокаде не загружая каждый раз в ручную после каждой правки ?это реально ?

Чуть-чуть офтопично - можно ли точки жирными сделать а автокаде ? при pdmode 0 - жирности нет, при pdmode 33 - кружок, но не залитый...
мне точки нужно представить как жирные точки, читай круги залитые черным

[VVA]

Код:

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

;|=================================================================== 
*    Функция возвращает vla-активное пространство (лист / модель). 
=====================================================================|;
(defun lib:get-active-space ( / adoc)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (and (zerop (vla-get-activespace adoc))(= :vlax-false (vla-get-mspace adoc)))
    (vla-get-paperspace adoc)(vla-get-modelspace adoc)))
;;; создания текста объектным методом
;;; На базе ru-text-add
;;; http://www.autocad.ru/cgi-bin/f1/board.cgi?t=30203Tc
(defun text-add (txt pnt height rotation justification / obj)
  ;| justification:
 0 acAlignmentLeft       6 acAlignmentTopLeft        12 acAlignmentBottomLeft
 1 acAlignmentCenter     7 acAlignmentTopCenter      13 acAlignmentBottomCenter
 2 acAlignmentRight      8 acAlignmentTopRight       14 acAlignmentBottomRight
 3 acAlignmentAligned    9 acAlignmentMiddleLeft
 4 acAlignmentMiddle    10 acAlignmentMiddleCenter
 5 acAlignmentFit       11 acAlignmentMiddleRight    |;
(if (null justification)(setq justification acalignmentleft))
  (setq obj (vla-addtext (LIB:GET-ACTIVE-SPACE) txt
             (if (or (= justification acalignmentaligned)(= justification acalignmentfit))
                (vlax-3d-point (car pnt))(vlax-3d-point pnt)) height))
  (cond  ((= justification acalignmentleft)
           (vla-put-rotation obj rotation))
          ((or (= justification acalignmentaligned)
               (= justification acalignmentfit))
           (vla-put-alignment obj justification)
           (vla-put-textalignmentpoint obj (vlax-3d-point (cadr pnt))))
          (t (vla-put-alignment obj justification)
           (vla-put-textalignmentpoint obj (vlax-3d-point pnt))
           (vla-put-rotation obj rotation)))
  (vla-update obj)  obj) ;_ end of defun

;;задаем команду и список исп. переменных 
(defun C:SL ( / ssline Htxt Ltxt Okr pt0 pt1 len ptc ang angtxt pttxt txt adoc) 
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-StartUndoMark adoc)  
;;; -> (setq ssline (ssget "_X" '((0 . "LINE")))) ;_Линии со всего чертежа
(setq ssline (ssget '((0 . "LINE"))))  ;_Выбор линий запрашивается у пользователя. Обрабатывается предварительный выбор
;;; Переводим набор в список Vla объектов  
(setq ssline (mapcar 'vlax-ename->vla-object(if ssline (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssline))) nil))) 
(setq Htxt (getvar "DIMTXT")  ;_Высота текста 
      Ltxt (getvar "DIMGAP")  ;_Отступ от размерной 
      Okr  (getvar "DIMDEC")) ;_Точность округления 
;;Цикл над каждым элементом ssline 
(foreach item ssline 
;; pt1,0 - коорд. концов , ptc коорд. центра 
  (setq pt0 (vlax-curve-getStartPoint item) 
   pt1 (vlax-curve-getEndPoint item) 
   len (vlax-curve-getEndParam item) 
   ptc (vlax-curve-getPointAtParam item (* 0.5 len)) 
;;направление отрезка 
   ang (angle (trans pt0 0 1)(trans pt1 0 1)) 
;;разворачиваем чтобы вверх ногами текста не было 
     angtxt (cond ((and (>= ang 0)(<= ang (* 0.5001 pi)))  ang) ;_I четверть 
        ((and (> ang (* 0.5 pi))(<= ang (* 1.5001 pi)))(+ ang PI));_II и III четверть 
        (t ang));_IV четверть 
;;задаем место текста учитываю отступ - 
   pttxt (polar ptc (if (equal ang angtxt 0.001)(+ ang (* 0.5 pi))(- ang (* 0.5 pi))) 
           Ltxt))
;|(rtos len 2 Okr) - текст
             pttxt - точка втавки в МСК
             HTXT  - высота
            angtxt - угол в радианах
           acAlignmentCenter - выравнивание |;
(setq txt (text-add  (rtos len 2 Okr) pttxt HTXT angtxt acAlignmentCenter))
);_foreach
(vla-EndUndoMark adoc)(princ))

1. Задано тексту выравнивание по центру acAlignmentCenter
2. в строку вывода чего? и что дописать?
3. Н.Полещук "VisualLisp и секреты адаптации AUtoCAD"
Н. Полещук "AutoLISP и Visual LISP в среде Autocad"
4. В ком. строке VLIDE Там на панели есть кнопочки со стрелочками сниз.

[VVA]

К слову:
1. сделана группировка для отмены одним действием
(vla-StartUndoMark adoc) (vla-EndtUndoMark adoc)
2. Корректно пишется тескт в UCS
ang (angle (trans pt0 0 1)(trans pt1 0 1))
3. Помимо книг самый большой опыт даст анализ лиспа на этом форуме и autocad.ru. По крайней мере с точки зрения работы с vla-функциями.
Если не понятко как работать с vla-функцией - набери ее в гугле.

[bdfy]

2. в строку вывода чего? и что дописать?

в надпись как добавить произвольный текст ? в моем случае еденицы измерения. т.е чтобы была надпись не просто "32" , а "32 км"
Или в другом случае "Общая длинна: 220 км". понятно теперь о чем я ?
3. Вообще интересуют электронные справочники

[VVA]

2. Измени эту строку

Код:

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

(setq txt (text-add  (rtos len 2 Okr) pttxt HTXT angtxt acAlignmentCenter))

На

Код:

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

(setq txt (text-add  
(strcat  "Общая длинна "  ;_Префикс
            (rtos len 2 Okr)    ;_Сам тескт
            " км.")                ;_Суффикс
 pttxt HTXT angtxt acAlignmentCenter))

Или

Код:

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

(setq txt (text-add  
(strcat  (rtos len 2 Okr)    ;_Сам тескт
            " км.")                ;_Суффикс
 pttxt HTXT angtxt acAlignmentCenter))

3. [sm2100]

Чуть-чуть офтопично - можно ли точки жирными сделать а автокаде ? при pdmode 0 - жирности нет, при pdmode 33 - кружок, но не залитый...

Точки (POINT) Автокада игнорируют вес линий. Они нужны для дополнительных построений.

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

_donut Внутренний диаметр 0; Внешний - какой тебе нужно

[CTPAHHNK]

Как узнать длинну всех выделенных линий без лиспа и редакторов ?
AutoGad 2012 LT

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

_.dataextraction в LT работает?

[CTPAHHNK]

Сообщение от Кулик Алексей aka kpblc _.dataextraction в LT работает?

Нет. Не распознает команду.

По-русски "Извлечение данных" тоже.

[Vladimir_Sergeevich]

Сообщение от CTPAHHNK AutoGad 2012 LT

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