[bdfy]

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

[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, решено для подобных задач оставить пару полных лицензий.