Написание Lisp для вычленение информации из massprop и вставки ее в текст модели

Тропок · 15.04.2015, 08:00

Дорого времени суток, очень нужно написать lisp по средствам которого можно вычленить значение mass из команды massprop и вставить, полученное значение в multi text.

Кулик Алексей aka kpblc · 15.04.2015, 10:13

Для какого объекта пытаешься получить данные? Солид? Регион?

----- добавлено через 55 сек. -----
Хотя, в принципе, фиолетово. Преобразовываешь объект в vlax-представление и через vla-get-property получаешь значение нужного свойства. Потом это полученное значение преобразовать в строку - и все.

----- добавлено через ~1 мин. -----
Ну или программно же создавать поле: на форуме соответствующие функции были.

Тропок · Регистрация: 23.05.2008

А где были на форуме, может в качестве тега, если есть возможность ссылку кидануть было-бы круто

Кулик Алексей aka kpblc · 15.04.2015, 23:33

Цитата:

Сообщение от Тропок

А где были на форуме

Поиск рулит! Нечто типа "Вставка поля..."

Тропок · 15.04.2015, 23:41

Цитата:

Сообщение от Кулик Алексей aka kpblc

Преобразовываешь объект в vlax-представление и через vla-get-property получаешь значение нужного свойства. Потом это полученное значение преобразовать в строку - и все.

поправьте меня если я ошибаюсь, но в property объектов 3D солид и полисолид нет свойств площадь или объем. общая задачка научится собирать площади и объемы с 3D объектов автоматически, для регионов такой проблемы нет в атрибут можно легко через филд загнать свойства, но это работает только для одного региона а если их 100 то нужно использовать либо лисп либо ареа тыкать в каждый в любом случае в конце куча механической работы, вот и возникла идея Massprop использовать.

----- добавлено через ~6 мин. -----

Цитата:

Сообщение от Кулик Алексей aka kpblc

Преобразовываешь объект в vlax-представление и через vla-get-property

И может есть еще какя инфа по преобразованию в vla объект.

Кулик Алексей aka kpblc · 16.04.2015, 01:06

Что такое "полисолид"- не представляю.
У 3DSOLID действительно нет понятия "площадь". Вот только вопрос, а на фига она нужна - если получение идет для mass. Берешь объем и умножаешь на плотность материала - в чем проблема-то?

----- добавлено через 53 сек. -----
Кстати, понятие объема есть только у 3DSOLID, у REGION, как и следует ожидать, этого свойства нет в принципе. Ты уж определись (для начала с типами объектов) да задай вопрос конкретнее.

flareon · 24.11.2015, 15:00

Здравствуйте! Подскажите пожалуйста (в поиске не нашел), а существует возможность вывода объемов 3Dsolids в текстовый файл? massprop выводит в окошко лишь объем одного или сумму нескольких солидов, а мне б так чтоб списком...Где-то об этом слышал, а где, ума не приложу...Заранее спасибо!

Дима_ · 24.11.2015, 21:55

Существует возможность получения объемов и возможность записи в файл. Свойство Volume и функции open, write и close.

flareon · 24.11.2015, 23:18

Спасибо за оперативность! Только вот я совсем ничего не понял. Можете как-нибудь для невладеющего язаками программирования пояснить? Заранее спасибо!

Кулик Алексей aka kpblc · 24.11.2015, 23:38

Цитата:

Сообщение от flareon

как-нибудь для невладеющего язаками программирования

Раздел "Поиск исполнителей". В любом случае - в отдельную тему.

arkizner · 15.11.2017, 00:57

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

необходимо его немного модернизировать

момент показывает правилно но в мм4 а мне надо в см4
все осталное в норме
еше нехватает параметра внешнего периметра

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

вот на англ:

1. I need show moment of inertia I[xx];[yy] but in CM4;
2. I also i need add some parametr:
Wx=Ixx*10/a1 (a1- promt to pic dimention value);
Wy=Iyy*10/b1 (b1- promt to pic other dimention value);

Код:

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

(defun c:WriteMass (/ *error* _get _doc cho f cl o b l _l _l1 _l2 ar srt fnd)
;;; -------------------------------------------------    ;;;
;;;    ---=== { Author : Tharwat Al Shoufi } ===---      ;;;
;;;                                                      ;;;
;;;     Write mass properties to Attributed Block(s)     ;;;
;;; -------------------------------------------------    ;;;
  (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (x)
    (if (and f (setq f (findfile f)))
      (vl-file-delete f)
    )
    (if cho
      (setvar 'cmdecho cho)
    )
    (if (and x
             (not (wcmatch (strcase x) "*BREAK*,*EXIT*,*CANCEL*"))
        )
      (princ "Error:" x "...")
    )
  )
;;;                                ;;;
  (defun _get (f / of s lst l)
    (if (and (setq of (open f "r"))
             (while
               (setq s (read-line of))
                (setq lst (cons s lst))
             )
        )
      (progn
        (close of)
        (if (setq lst (reverse lst))
          (mapcar '(lambda (i) (setq l (cons (nth i lst) l)))
                  '(3 4 5 6 9 10 12 13)
          )
        )
        (setq l (reverse l))
      )
    )
    l
  )
;;;                                ;;;
  (cond
    ((or (minusp (cdr (assoc 62
                             (setq cl
                                    (entget
                                      (tblobjname "LAYER" (getvar 'CLAYER))
                                    )
                             )
                      )
                 )
         )
         (= 4 (logand 4 (cdr (assoc 70 cl))))
     )
     (alert "<!> Current Layer is either OFF or LOCKED <!>")
    )
    ((and
       (princ
         "\n Select CLOSED Object [REGION,CIRCLE,ELLIPSE,LWpolyline] :"
       )
       (not (setq o (ssget "_+.:S:E:L"
                           '((-4 . "<OR")
                             (0 . "REGION,CIRCLE,ELLIPSE")
                             (-4 . "<AND")
                             (0 . "LWPOLYLINE")
                             (-4 . "&=")
                             (70 . 1)
                             (-4 . "AND>")
                             (-4 . "OR>")
                            )
                    )
            )
       )
     )
     (alert
       "\n << nil or Invalid Object or on Locked Layer !! >>"
     )
    )
    ((and (princ "\n Select Attributed Block(s) :")
          (not (setq b (ssget "_:L" '((0 . "INSERT") (66 . 1)))))
     )
     (alert "Invalid object . Should be Attributed Block(s) !")
    )
  )
  (if (and b
           (if (not (setq f (vl-filename-mktemp nil nil ".mpr")))
             (alert "Can't create the text file !!")
             t
           )
      )
    (progn
      (if (eq (cdr (assoc 0 (entget (ssname o 0)))) "REGION")
        (setq r (list (vlax-ename->vla-object (ssname o 0))))
        (setq r (vl-catch-all-apply
                  'vlax-invoke
                  (list
                    (vla-get-block
                      (vla-get-activelayout
                        (vla-get-ActiveDocument
                          (vlax-get-acad-object)
                        )
                      )
                    )
                    'Addregion
                    (list (vlax-ename->vla-object (ssname o 0)))
                  )
                )
              d t
        )
      )
      (setq cho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "_.ucs"
               "_Origin"
               (setq p (vlax-get (car r) 'Centroid))
      )
      (command "_.massprop"
               (vlax-vla-object->ename (car r))
               ""
               "y"
               (vl-string-translate "\\" "/" f)
      )
      (command "_.ucs" "w")
      (setvar 'cmdecho cho)
      (if d
        (vla-delete (car r))
      )
      (if (zerop (getvar 'PDMODE))
        (setvar 'PDMODE 34)
      )
      (entmake
        (list '(0 . "POINT")
              (cons 10 p)
        )
      )
      (if (setq l (_get f))
        (progn
          (setq _l1 (mapcar
                      '(lambda (s d / p a b c)
                         (setq p (vl-string-search d s)
                               a (vl-string-trim
                                   " "
                                   (substr s (+ p 3))
                                 )
                               p (vl-string-search "--" a)
                               b (substr a 1 p)
                               c (vl-string-trim
                                   " "
                                   (substr a (+ p 3))
                                 )
                               b (if (wcmatch b "-*")
                                   (substr b 2)
                                   b
                                 )
                               c (if (wcmatch c "-*")
                                   (substr c 2)
                                   c
                                 )
                         )
                         (mapcar '(lambda (x) (vl-string-trim " " x))
                                 (list b c)
                         )
                       )
                      (list (nth 2 l) (nth 3 l))
                      '("X:" "Y:")
                    )
                _l2 (mapcar '(lambda (s d / p a)
                               (setq p (vl-string-search d s)
                                     a (vl-string-trim
                                         " "
                                         (substr (vl-string-trim
                                                   " "
                                                   (substr s (+ p 3))
                                                 )
                                                 1
                                                 p
                                         )
                                       )
                               )
                               a
                             )
                            (list (nth 4 l)
                                  (nth 5 l)
                                  (nth 6 l)
                                  (nth 7 l)
                            )
                            '("X:" "Y:" "X:" "Y:")
                    )
                ar  (vl-string-trim " " (substr (car l) 6))
                srt (list
                      ar
                      (vl-string-trim " " (substr (cadr l) 12))
                      (rtos (max (read (caar _l1))
                                 (read (cadar _l1))
                            )
                            2
                            3
                      )
                      (rtos (max (read (caadr _l1))
                                 (read (cadadr _l1))
                            )
                            2
                            3
                      )
                      "0.0000"
                      "0.0000"
                      (car _l2)
                      (cadr _l2)
                      (rtos (/ (read (car _l2))
                               (max (read (caadr _l1))
                                    (read (cadadr _l1))
                               )
                            )
                            2
                            3
                      )
                      (rtos (/ (read (cadr _l2))
                               (max (read (caar _l1))
                                    (read (cadar _l1))
                               )
                            )
                            2
                            3
                      )
                      (caddr _l2)
                      (nth 3 _l2)
                      (rtos (* (read ar) 0.00271) 2 3)
                    )
                _l  (mapcar '(lambda (j k) (cons j k))
                            '("AREA" "PERIMETER" "BOUNDING_BOX_X_MAX"
                              "BOUNDING_BOX_Y_MAX" "CENTROID_X"
                              "CENTROID_Y" "MOMENT_OF_INERTIA_X"
                              "MOMENT_OF_INERTIA_Y" "SECTION_MODULUS_ZX"
                              "SECTION_MODULUS_ZY"
                              "RADIUS_OF_GYRATION_X"
                              "RADIUS_OF_GYRATION_Y" "WEIGHT"
                             )
                            srt
                    )
          )
          (vla-startUndomark _doc)
          ((lambda (n / sn)
             (while (setq sn (ssname b (setq n (1+ n))))
               (mapcar
                 '(lambda (x)
                    (if (setq
                          fnd (assoc (vla-get-tagstring x)
                                     _l
                              )
                        )
                      (vla-put-textstring x (cdr fnd))
                    )
                  )
                 (vlax-invoke
                   (vlax-ename->vla-object sn)
                   'getattributes
                 )
               )
             )
           )
            -1
          )
          (vla-endundomark _doc)
        )
      )
    )
  )
  (terpri)
  (*error* nil)
  (princ "\nThis Program is written by Tharwat Al Shoufi .")
  (princ)
)
(vl-load-com)
(princ
  "\n** Type WriteMass to start.. Author: Tharwat Al Shoufi .*"
)
(princ)

file with attributes table:
https://drive.google.com/open?id=18q...zgBGW_JPyHVPQI

очень нужна помощь

Boxa · 15.11.2017, 06:58

Я человек довольно далекий от Lisp, но
- Не увидел в коде преобразование единиц измерения, чертите в см и программа будет выводить в см.
- Программа выводит периметр, в районе 229 строки виден набор тегов и в районе 250 строки он вроде бы выводится в атрибут. Хотя Вам нужен какой то "Внешний периметр", что это такое?
- Wx и Wy формулы Вы привели, все параметры у Вас есть, в чем сложность посчитать и вывести. Пример вывода в коде есть, примеры умножения и деления в коде так же есть ?

Так чем Вам помочь то? Что именно у Вас не получается?

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

VVA · 15.11.2017, 08:59

По п. 1 в этом месте

Код:

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

 _l  (mapcar '(lambda (j k) (cons j k))
                            '("AREA" "PERIMETER" "BOUNDING_BOX_X_MAX"
                              "BOUNDING_BOX_Y_MAX" "CENTROID_X"
                              "CENTROID_Y" "MOMENT_OF_INERTIA_X"
                              "MOMENT_OF_INERTIA_Y" "SECTION_MODULUS_ZX"
                              "SECTION_MODULUS_ZY"
                              "RADIUS_OF_GYRATION_X"
                              "RADIUS_OF_GYRATION_Y" "WEIGHT"
                             )
                            srt
                    )

в переменную _l формируется результирующий список. Значения хранятся в списке srt
Добавь строчкой выше корректировку моментов ( 7 и 8 индекс, начиная с 0)
Что-то типа

Код:

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

;;;==== Add before _L BEGIN ==========
              srt  (mapcar '(lambda (j k)(* j k))
                   srt
                   '(1	 ;_AREA;_
                     1	 ;_PERIMETER;_
                     1	 ;_BOUNDING_BOX_X_MAX;_
                     1	 ;_BOUNDING_BOX_Y_MAX;_
                     1	 ;_CENTROID_X;_
                     1	 ;_CENTROID_Y;_
                     0.0001	 ;_MOMENT_OF_INERTIA_X;_
                     0.0001	 ;_MOMENT_OF_INERTIA_Y;_
                     1	 ;_SECTION_MODULUS_ZX;_
                     1	 ;_SECTION_MODULUS_ZY;_
                     1	 ;_RADIUS_OF_GYRATION_X;_
                     1	 ;_RADIUS_OF_GYRATION_Y;_
                     1 	 ;_WEIGHT;_
                     )
                   )
;;;==== Add before _L END ==========
                _l  (mapcar '(lambda (j k) (cons j k))
                            '("AREA" "PERIMETER" "BOUNDING_BOX_X_MAX"
                              "BOUNDING_BOX_Y_MAX" "CENTROID_X"
                              "CENTROID_Y" "MOMENT_OF_INERTIA_X"
                              "MOMENT_OF_INERTIA_Y" "SECTION_MODULUS_ZX"
                              "SECTION_MODULUS_ZY"
                              "RADIUS_OF_GYRATION_X"
                              "RADIUS_OF_GYRATION_Y" "WEIGHT"
                             )
                            srt
                    )

arkizner · 15.11.2017, 15:01

Я НЕМНОГО НЕ ПОИМУ ГДЕ ВСТАВИТь ТЕХТ

НУЖНО ЛИ ЧТО ТО СТИРАТь?

ВОТ КОД - Я ПОНЯЛ ВЕРНО?

Код:

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

(defun c:WriteMass (/ *error* _get _doc cho f cl o b l _l _l1 _l2 ar srt fnd)
;;; -------------------------------------------------    ;;;
;;;    ---=== { Author : Tharwat Al Shoufi } ===---      ;;;
;;;                                                      ;;;
;;;     Write mass properties to Attributed Block(s)     ;;;
;;; -------------------------------------------------    ;;;
  (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (x)
    (if (and f (setq f (findfile f)))
      (vl-file-delete f)
    )
    (if cho
      (setvar 'cmdecho cho)
    )
    (if (and x
             (not (wcmatch (strcase x) "*BREAK*,*EXIT*,*CANCEL*"))
        )
      (princ "Error:" x "...")
    )
  )
;;;                                ;;;
  (defun _get (f / of s lst l)
    (if (and (setq of (open f "r"))
             (while
               (setq s (read-line of))
                (setq lst (cons s lst))
             )
        )
      (progn
        (close of)
        (if (setq lst (reverse lst))
          (mapcar '(lambda (i) (setq l (cons (nth i lst) l)))
                  '(3 4 5 6 9 10 12 13)
          )
        )
        (setq l (reverse l))
      )
    )
    l
  )
;;;                                ;;;
  (cond
    ((or (minusp (cdr (assoc 62
                             (setq cl
                                    (entget
                                      (tblobjname "LAYER" (getvar 'CLAYER))
                                    )
                             )
                      )
                 )
         )
         (= 4 (logand 4 (cdr (assoc 70 cl))))
     )
     (alert "<!> Current Layer is either OFF or LOCKED <!>")
    )
    ((and
       (princ
         "\n Select CLOSED Object [REGION,CIRCLE,ELLIPSE,LWpolyline] :"
       )
       (not (setq o (ssget "_+.:S:E:L"
                           '((-4 . "<OR")
                             (0 . "REGION,CIRCLE,ELLIPSE")
                             (-4 . "<AND")
                             (0 . "LWPOLYLINE")
                             (-4 . "&=")
                             (70 . 1)
                             (-4 . "AND>")
                             (-4 . "OR>")
                            )
                    )
            )
       )
     )
     (alert
       "\n << nil or Invalid Object or on Locked Layer !! >>"
     )
    )
    ((and (princ "\n Select Attributed Block(s) :")
          (not (setq b (ssget "_:L" '((0 . "INSERT") (66 . 1)))))
     )
     (alert "Invalid object . Should be Attributed Block(s) !")
    )
  )
  (if (and b
           (if (not (setq f (vl-filename-mktemp nil nil ".mpr")))
             (alert "Can't create the text file !!")
             t
           )
      )
    (progn
      (if (eq (cdr (assoc 0 (entget (ssname o 0)))) "REGION")
        (setq r (list (vlax-ename->vla-object (ssname o 0))))
        (setq r (vl-catch-all-apply
                  'vlax-invoke
                  (list
                    (vla-get-block
                      (vla-get-activelayout
                        (vla-get-ActiveDocument
                          (vlax-get-acad-object)
                        )
                      )
                    )
                    'Addregion
                    (list (vlax-ename->vla-object (ssname o 0)))
                  )
                )
              d t
        )
      )
      (setq cho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "_.ucs"
               "_Origin"
               (setq p (vlax-get (car r) 'Centroid))
      )
      (command "_.massprop"
               (vlax-vla-object->ename (car r))
               ""
               "y"
               (vl-string-translate "\\" "/" f)
      )
      (command "_.ucs" "w")
      (setvar 'cmdecho cho)
      (if d
        (vla-delete (car r))
      )
      (if (zerop (getvar 'PDMODE))
        (setvar 'PDMODE 34)
      )
      (entmake
        (list '(0 . "POINT")
              (cons 10 p)
        )
      )
      (if (setq l (_get f))
        (progn
          (setq _l1 (mapcar
                      '(lambda (s d / p a b c)
                         (setq p (vl-string-search d s)
                               a (vl-string-trim
                                   " "
                                   (substr s (+ p 3))
                                 )
                               p (vl-string-search "--" a)
                               b (substr a 1 p)
                               c (vl-string-trim
                                   " "
                                   (substr a (+ p 3))
                                 )
                               b (if (wcmatch b "-*")
                                   (substr b 2)
                                   b
                                 )
                               c (if (wcmatch c "-*")
                                   (substr c 2)
                                   c
                                 )
                         )
                         (mapcar '(lambda (x) (vl-string-trim " " x))
                                 (list b c)
                         )
                       )
                      (list (nth 2 l) (nth 3 l))
                      '("X:" "Y:")
                    )
                _l2 (mapcar '(lambda (s d / p a)
                               (setq p (vl-string-search d s)
                                     a (vl-string-trim
                                         " "
                                         (substr (vl-string-trim
                                                   " "
                                                   (substr s (+ p 3))
                                                 )
                                                 1
                                                 p
                                         )
                                       )
                               )
                               a
                             )
                            (list (nth 4 l)
                                  (nth 5 l)
                                  (nth 6 l)
                                  (nth 7 l)
                            )
                            '("X:" "Y:" "X:" "Y:")
                    )
                ar  (vl-string-trim " " (substr (car l) 6))
                srt (list
                      ar
                      (vl-string-trim " " (substr (cadr l) 12))
                      (rtos (max (read (caar _l1))
                                 (read (cadar _l1))
                            )
                            2
                            3
                      )
                      (rtos (max (read (caadr _l1))
                                 (read (cadadr _l1))
                            )
                            2
                            3
                      )
                      "0.0000"
                      "0.0000"
                      (car _l2)
                      (cadr _l2)
                      (rtos (/ (read (car _l2))
                               (max (read (caadr _l1))
                                    (read (cadadr _l1))
                               )
                            )
                            2
                            3
                      )
                      (rtos (/ (read (cadr _l2))
                               (max (read (caar _l1))
                                    (read (cadar _l1))
                               )
                            )
                            2
                            3
                      )
                      (caddr _l2)
                      (nth 3 _l2)
                      (rtos (* (read ar) 0.00271) 2 3)
                    )

;;;==== Add before _L BEGIN ==========

    srt  (mapcar '(lambda (j k)(* j k))
                   srt
                   '(1	 ;_AREA;_
                     1	 ;_PERIMETER;_
                     1	 ;_BOUNDING_BOX_X_MAX;_
                     1	 ;_BOUNDING_BOX_Y_MAX;_
                     1	 ;_CENTROID_X;_
                     1	 ;_CENTROID_Y;_
                     0.0001	 ;_MOMENT_OF_INERTIA_X;_
                     0.0001	 ;_MOMENT_OF_INERTIA_Y;_
                     1	 ;_SECTION_MODULUS_ZX;_
                     1	 ;_SECTION_MODULUS_ZY;_
                     1	 ;_RADIUS_OF_GYRATION_X;_
                     1	 ;_RADIUS_OF_GYRATION_Y;_
                     1 	 ;_WEIGHT;_
                     )
;;;==== Add before _L END ==========

                _l  (mapcar '(lambda (j k) (cons j k))
                            '("AREA" "PERIMETER" "BOUNDING_BOX_X_MAX"
                              "BOUNDING_BOX_Y_MAX" "CENTROID_X"
                              "CENTROID_Y" "MOMENT_OF_INERTIA_X"
                              "MOMENT_OF_INERTIA_Y" "SECTION_MODULUS_ZX"
                              "SECTION_MODULUS_ZY"
                              "RADIUS_OF_GYRATION_X"
                              "RADIUS_OF_GYRATION_Y" "WEIGHT"
                             )
                            srt
                    )
          )
          (vla-startUndomark _doc)
          ((lambda (n / sn)
             (while (setq sn (ssname b (setq n (1+ n))))
               (mapcar
                 '(lambda (x)
                    (if (setq
                          fnd (assoc (vla-get-tagstring x)
                                     _l
                              )
                        )
                      (vla-put-textstring x (cdr fnd))
                    )
                  )
                 (vlax-invoke
                   (vlax-ename->vla-object sn)
                   'getattributes
                 )
               )
             )
           )
            -1
          )
          (vla-endundomark _doc)
        )
      )
    )
  )
  (terpri)
  (*error* nil)
  (princ "\nThis Program is written by Tharwat Al Shoufi .")
  (princ)
)
(vl-load-com)
(princ
  "\n** Type WriteMass to start.. Author: Tharwat Al Shoufi .*"
)
(princ)

VVA · 15.11.2017, 17:38

Стирать ничего не нужно. Да
Пропущена скобка. Проверить не могу, не понятно какой блок требует

Код:

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

(defun c:WriteMass (/ *error* _get _doc cho f cl o b l _l _l1 _l2 ar srt fnd)
;;; -------------------------------------------------    ;;;
;;;    ---=== { Author : Tharwat Al Shoufi } ===---      ;;;
;;;                                                      ;;;
;;;     Write mass properties to Attributed Block(s)     ;;;
;;; -------------------------------------------------    ;;;
  (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (x)
    (if (and f (setq f (findfile f)))
      (vl-file-delete f)
    )
    (if cho
      (setvar 'cmdecho cho)
    )
    (if (and x
             (not (wcmatch (strcase x) "*BREAK*,*EXIT*,*CANCEL*"))
        )
      (princ "Error:" x "...")
    )
  )
;;;                                ;;;
  (defun _get (f / of s lst l)
    (if (and (setq of (open f "r"))
             (while
               (setq s (read-line of))
                (setq lst (cons s lst))
             )
        )
      (progn
        (close of)
        (if (setq lst (reverse lst))
          (mapcar '(lambda (i) (setq l (cons (nth i lst) l)))
                  '(3 4 5 6 9 10 12 13)
          )
        )
        (setq l (reverse l))
      )
    )
    l
  )
;;;                                ;;;
  (cond
    ((or (minusp (cdr (assoc 62
                             (setq cl
                                    (entget
                                      (tblobjname "LAYER" (getvar 'CLAYER))
                                    )
                             )
                      )
                 )
         )
         (= 4 (logand 4 (cdr (assoc 70 cl))))
     )
     (alert "<!> Current Layer is either OFF or LOCKED <!>")
    )
    ((and
       (princ
         "\n Select CLOSED Object [REGION,CIRCLE,ELLIPSE,LWpolyline] :"
       )
       (not (setq o (ssget "_+.:S:E:L"
                           '((-4 . "<OR")
                             (0 . "REGION,CIRCLE,ELLIPSE")
                             (-4 . "<AND")
                             (0 . "LWPOLYLINE")
                             (-4 . "&=")
                             (70 . 1)
                             (-4 . "AND>")
                             (-4 . "OR>")
                            )
                    )
            )
       )
     )
     (alert
       "\n << nil or Invalid Object or on Locked Layer !! >>"
     )
    )
    ((and (princ "\n Select Attributed Block(s) :")
          (not (setq b (ssget "_:L" '((0 . "INSERT") (66 . 1)))))
     )
     (alert "Invalid object . Should be Attributed Block(s) !")
    )
  )
  (if (and b
           (if (not (setq f (vl-filename-mktemp nil nil ".mpr")))
             (alert "Can't create the text file !!")
             t
           )
      )
    (progn
      (if (eq (cdr (assoc 0 (entget (ssname o 0)))) "REGION")
        (setq r (list (vlax-ename->vla-object (ssname o 0))))
        (setq r (vl-catch-all-apply
                  'vlax-invoke
                  (list
                    (vla-get-block
                      (vla-get-activelayout
                        (vla-get-ActiveDocument
                          (vlax-get-acad-object)
                        )
                      )
                    )
                    'Addregion
                    (list (vlax-ename->vla-object (ssname o 0)))
                  )
                )
              d t
        )
      )
      (setq cho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "_.ucs"
               "_Origin"
               (setq p (vlax-get (car r) 'Centroid))
      )
      (command "_.massprop"
               (vlax-vla-object->ename (car r))
               ""
               "_y"
               (vl-string-translate "\\" "/" f)
      )
      (command "_.ucs" "_w")
      (setvar 'cmdecho cho)
      (if d
        (vla-delete (car r))
      )
      (if (zerop (getvar 'PDMODE))
        (setvar 'PDMODE 34)
      )
      (entmake
        (list '(0 . "POINT")
              (cons 10 p)
        )
      )
      (if (setq l (_get f))
        (progn
          (setq _l1 (mapcar
                      '(lambda (s d / p a b c)
                         (setq p (vl-string-search d s)
                               a (vl-string-trim
                                   " "
                                   (substr s (+ p 3))
                                 )
                               p (vl-string-search "--" a)
                               b (substr a 1 p)
                               c (vl-string-trim
                                   " "
                                   (substr a (+ p 3))
                                 )
                               b (if (wcmatch b "-*")
                                   (substr b 2)
                                   b
                                 )
                               c (if (wcmatch c "-*")
                                   (substr c 2)
                                   c
                                 )
                         )
                         (mapcar '(lambda (x) (vl-string-trim " " x))
                                 (list b c)
                         )
                       )
                      (list (nth 2 l) (nth 3 l))
                      '("X:" "Y:")
                    )
                _l2 (mapcar '(lambda (s d / p a)
                               (setq p (vl-string-search d s)
                                     a (vl-string-trim
                                         " "
                                         (substr (vl-string-trim
                                                   " "
                                                   (substr s (+ p 3))
                                                 )
                                                 1
                                                 p
                                         )
                                       )
                               )
                               a
                             )
                            (list (nth 4 l)
                                  (nth 5 l)
                                  (nth 6 l)
                                  (nth 7 l)
                            )
                            '("X:" "Y:" "X:" "Y:")
                    )
                ar  (vl-string-trim " " (substr (car l) 6))
                srt (list
                      ar
                      (vl-string-trim " " (substr (cadr l) 12))
                      (rtos (max (read (caar _l1))
                                 (read (cadar _l1))
                            )
                            2
                            3
                      )
                      (rtos (max (read (caadr _l1))
                                 (read (cadadr _l1))
                            )
                            2
                            3
                      )
                      "0.0000"
                      "0.0000"
                      (car _l2)
                      (cadr _l2)
                      (rtos (/ (read (car _l2))
                               (max (read (caadr _l1))
                                    (read (cadadr _l1))
                               )
                            )
                            2
                            3
                      )
                      (rtos (/ (read (cadr _l2))
                               (max (read (caar _l1))
                                    (read (cadar _l1))
                               )
                            )
                            2
                            3
                      )
                      (caddr _l2)
                      (nth 3 _l2)
                      (rtos (* (read ar) 0.00271) 2 3)
                    )
;;;==== Add before _L BEGIN ==========

    srt  (mapcar '(lambda (j k)(rtos (* (read j) k) 2 3))
                   srt
                   '(1	 ;_AREA;_
                     1	 ;_PERIMETER;_
                     1	 ;_BOUNDING_BOX_X_MAX;_
                     1	 ;_BOUNDING_BOX_Y_MAX;_
                     1	 ;_CENTROID_X;_
                     1	 ;_CENTROID_Y;_
                     0.0001	 ;_MOMENT_OF_INERTIA_X;_
                     0.0001	 ;_MOMENT_OF_INERTIA_Y;_
                     1	 ;_SECTION_MODULUS_ZX;_
                     1	 ;_SECTION_MODULUS_ZY;_
                     1	 ;_RADIUS_OF_GYRATION_X;_
                     1	 ;_RADIUS_OF_GYRATION_Y;_
                     1 	 ;_WEIGHT;_
                     )
                 )
;;;==== Add before _L END ==========

                _l  (mapcar '(lambda (j k) (cons j k))
                            '("AREA" "PERIMETER" "BOUNDING_BOX_X_MAX"
                              "BOUNDING_BOX_Y_MAX" "CENTROID_X"
                              "CENTROID_Y" "MOMENT_OF_INERTIA_X"
                              "MOMENT_OF_INERTIA_Y" "SECTION_MODULUS_ZX"
                              "SECTION_MODULUS_ZY"
                              "RADIUS_OF_GYRATION_X"
                              "RADIUS_OF_GYRATION_Y" "WEIGHT"
                             )
                            srt
                    )
          )
          (vla-startUndomark _doc)
          ((lambda (n / sn)
             (while (setq sn (ssname b (setq n (1+ n))))
               (mapcar
                 '(lambda (x)
                    (if (setq
                          fnd (assoc (vla-get-tagstring x)
                                     _l
                              )
                        )
                      (vla-put-textstring x (cdr fnd))
                    )
                  )
                 (vlax-invoke
                   (vlax-ename->vla-object sn)
                   'getattributes
                 )
               )
             )
           )
            -1
          )
          (vla-endundomark _doc)
        )
      )
    )
  )
  (terpri)
  (*error* nil)
  (princ "\nThis Program is written by Tharwat Al Shoufi .")
  (princ)
)
(vl-load-com)
(princ
  "\n** Type WriteMass to start.. Author: Tharwat Al Shoufi .*"
)
(princ)

zenon · 15.11.2017, 18:11

arkizner, а орать зачем?

arkizner · 16.11.2017, 01:34

спасибо огромное - вот теперь все ясно и понятно - ясно где добавлять

еше один маленкий нюанс остался

как мне добавить периметр только внешней стороны профиля?

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

Кулик Алексей aka kpblc · 16.11.2017, 08:21

Создавай сечение и высчитывай нужные тебе данные.

arkizner · 18.11.2017, 23:33

я очень вам благодарен за помощь.
если можно - у меня есть еще 3 вопроса:
1. как добавить возможность в промежуток между выбором обэкта и подсчетом вот такой порядок функций
region from selected, subtract region,
а после подсчетов
exload selected previous, and join exploaded.
в резултате получить подсчет правильный и оставить обэкт как полилиния
2. как сделать выбор блока автоматическим - чтобы искал сам по фаилу?
3. как добавить внешний периметр обэкта?

Код:

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

(defun c:WM (/ *error* _get _doc cho f cl o b l _l _l1 _l2 ar srt fnd
                       zom cad obj dis pcs len pts out lft rgt sel int ent tot sum are reg blk)
;;; -------------------------------------------------    ;;;
;;;    ---=== { Author : Tharwat Al Shoufi } ===---      ;;;
;;;                                                      ;;;
;;;     Write mass properties to Attributed Block(s)     ;;;
;;; -------------------------------------------------    ;;;
  (defun *error* (x)
    (and f (findfile f) (vl-file-delete f))
    (if cho (setvar 'cmdecho cho))
    (if zom (vla-zoomprevious cad))
    (and tot r (vla-delete (car r)))
    (if (and x (not (wcmatch (strcase x) "*BREAK*,*EXIT*,*CANCEL*")))
      (princ "Error =>" x)
    )
  )
;;;                                ;;;
  (defun _get (f / of s lst l)
    (if (and (setq of (open f "r"))
             (while
               (setq s (read-line of))
                (setq lst (cons s lst))
             )
        )
      (progn
        (close of)
        (if (setq lst (reverse lst))
          (mapcar '(lambda (i) (setq l (cons (nth i lst) l)))
                  '(3 4 5 6 9 10 12 13)
          )
        )
        (setq l (reverse l))
      )
    )
    l
  )
;;;                                ;;;
  (cond ((or (minusp (cdr (assoc 62 (setq cl (entget (tblobjname "LAYER" (getvar 'CLAYER)))))))
             (= 4 (logand 4 (cdr (assoc 70 cl))))
             )
         (alert "<!> Current Layer is either OFF or LOCKED <!>")
         )
        ((and (princ "\nSelect CLOSED Object [REGION,LWpolyline] :")
              (not (setq o (ssget "_+.:S:E:L" '((-4 . "<OR")
                                (0 . "REGION")
                                (-4 . "<AND")
                                (0 . "LWPOLYLINE")
                                (-4 . "&=")
                                (70 . 1)
                                (-4 . "AND>")
                                (-4 . "OR>"))))))
         (alert "\n<< nil or Invalid Object or on Locked Layer !! >>")
        )
    ((and (princ "\nSelect Attributed Block(s) < MassProps >:")
          (not (setq b (ssget "_:L" '((0 . "INSERT") (2 . "MassProps") (66 . 1)))))
     )
     (alert "None of the Attributed blocks selected <!>")
    )
  )
  (if (and b (if (not (setq f (vl-filename-mktemp nil nil ".mpr")))
               (alert "Can't create the text file !!")
               t
           )
      )
    (progn
      (setq cad (vlax-get-acad-object)
           _doc (vla-get-activedocument cad)
            )
      (if (eq (cdr (assoc 0 (entget (ssname o 0)))) "REGION")
        (setq r (list (vlax-ename->vla-object (ssname o 0))))
      (and (setq obj (ssname o 0)
                 dis (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
                 pcs (/ dis 250)
                 len pcs
               )
     (progn
       (vla-getboundingbox (setq out (vlax-ename->vla-object obj)) 'lft 'rgt)
       (vla-zoomwindow cad rgt lft) (setq zom t)
       (setq sum (vla-get-area out))
       (repeat 250
         (setq pnt (vlax-curve-getpointatdist obj pcs))
         (if (not (vl-some '(lambda (p) (equal pnt p 1e-4)) pts))
           (setq pts (cons pnt pts))
           )
         (setq pcs (+ len pcs))
         )
       (setq int -1 tot 0. blk (vla-get-block (vla-get-activelayout (vla-get-ActiveDocument cad))))
       (and (setq r (vl-catch-all-apply 'vlax-invoke (list blk 'Addregion (list out))))
            (setq tot (+ tot (vla-get-perimeter (car r)))) 
            )
        pts
       )
     (setq are 0.0 sel (ssget "_WP" pts '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
     (progn
       (while (setq ent (ssname sel (setq int (1+ int))))
         (setq are (+ are (vlax-curve-getarea ent)))
       (and (setq reg (vl-catch-all-apply 'vlax-invoke (list blk 'Addregion (list (vlax-ename->vla-object ent)))))
            (setq tot (+ tot (vla-get-perimeter (car reg))))
            (vla-delete (car reg))
            )
       )
       (and (< 0.0 are)  (setq are (- sum are)))
       )
     )
      )
      (setq cho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "_.ucs" "_Origin" (setq p (vlax-get (car r) 'Centroid)))
      (command "_.massprop"      (vlax-vla-object->ename (car r))  "" "_y" (vl-string-translate "\\" "/" f))
      (command "_.ucs" "_w")
      (setvar 'cmdecho cho)
      (if (zerop (getvar 'PDMODE))
        (setvar 'PDMODE 34)
      )
      (entmake (list '(0 . "POINT") (cons 10 p)))
      (if (setq l (_get f))
        (progn
          (setq _l1 (mapcar
                      '(lambda (s d / p a b c)
                         (setq p (vl-string-search d s)
                               a (vl-string-trim " " (substr s (+ p 3)))
                               p (vl-string-search "--" a)
                               b (substr a 1 p)
                               c (vl-string-trim " " (substr a (+ p 3)))
                               b (if (wcmatch b "-*") (substr b 2) b)
                               c (if (wcmatch c "-*") (substr c 2) c)
                         )
                         (mapcar '(lambda (x) (vl-string-trim " " x)) (list b c))
                       )
                      (list (nth 2 l) (nth 3 l))
                      '("X:" "Y:")
                    )
                _l2 (mapcar '(lambda (s d / p a)
                               (setq p (vl-string-search d s)
                                     a (vl-string-trim  " " (substr (vl-string-trim " " (substr s (+ p 3))) 1 p))
                                     )
                               a
                             )
                            (list (nth 4 l) (nth 5 l) (nth 6 l) (nth 7 l))
                            '("X:" "Y:" "X:" "Y:")
                    )
                ar  (vl-string-trim " " (substr (car l) 6))
                srt (list ar (vl-string-trim " " (substr (cadr l) 12)) (rtos (max (read (caar _l1)) (read (cadar _l1))) 2 3)
                      (rtos (max (read (caadr _l1)) (read (cadadr _l1))) 2 3)  "0.0000" "0.0000" (car _l2) (cadr _l2)
                      (rtos (/ (read (car _l2)) (max (read (caadr _l1)) (read (cadadr _l1)))) 2 3)
                      (rtos (/ (read (cadr _l2))
                               (max (read (caar _l1))
                                    (read (cadar _l1))
                               )
                            )
                            2
                            3
                      )
                      (caddr _l2)
                      (nth 3 _l2)
                      (rtos (* (read ar) 0.00271) 2 3)
                    )
;;;==== Add before _L BEGIN ==========
    srt  (mapcar '(lambda (j k)(rtos (* (read j) k) 2 3))
                   srt
                   '(1	 ;_AREA;_
                     1	 ;_PERIMETER;_
                     1	 ;_BOUNDING_BOX_X_MAX;_
                     1	 ;_BOUNDING_BOX_Y_MAX;_
                     1	 ;_CENTROID_X;_
                     1	 ;_CENTROID_Y;_
                     0.0001	 ;_MOMENT_OF_INERTIA_X;_
                     0.0001	 ;_MOMENT_OF_INERTIA_Y;_
                     0.001	 ;_SECTION_MODULUS_ZX;_
                     0.001	 ;_SECTION_MODULUS_ZY;_
                     1	 ;_RADIUS_OF_GYRATION_X;_
                     1	 ;_RADIUS_OF_GYRATION_Y;_
                     1 	 ;_WEIGHT;_
                     )
                 )
;;;==== Add before _L END ==========

                _l  (mapcar '(lambda (j k) (cons j k))
                            '("AREA" "PERIMETER" "BOUNDING_BOX_X_MAX"
                              "BOUNDING_BOX_Y_MAX" "CENTROID_X"
                              "CENTROID_Y" "MOMENT_OF_INERTIA_X"
                              "MOMENT_OF_INERTIA_Y" "SECTION_MODULUS_ZX"
                              "SECTION_MODULUS_ZY"
                              "RADIUS_OF_GYRATION_X"
                              "RADIUS_OF_GYRATION_Y" "WEIGHT"
                             )
                            srt
                    )
          )
          (vla-startUndomark _doc)
          ((lambda (n / sn)
             (while (setq sn (ssname b (setq n (1+ n))))
               (mapcar
                 '(lambda (x)
                    (if (setq fnd (assoc (vla-get-tagstring x) _l))
                       (if (and tot (= (car fnd) "PERIMETER"))
                         (vla-put-textstring x (rtos tot 2 3))
                         (if (and (< 0.0 are) (= (car fnd) "AREA")) 
                          (vla-put-textstring x (rtos are 2 3))
                           (vla-put-textstring x (cdr fnd))
                           )
                         )
                    )
                  )
                 (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
               )
             )
           )
            -1
          )
          (vla-endundomark _doc)
        )
      )
    )
  )
  (terpri)
  (*error* nil)
  (princ "\nThis Program is written by Tharwat Al Shoufi .")
  (princ)
)
(vl-load-com)
(princ
  "\n** Type WriteMass to start.. Author: Tharwat Al Shoufi .*"
)
(princ)

----- добавлено через ~4 мин. -----
https://drive.google.com/open?id=1Xu...0H5l6Xpk9YWJF8
бот блок с аттрибутами

----- добавлено через ~8 мин. -----
обясню логику первого пункта:
лисп умеет считать все для региона а полилинии он считает не коректно. (кроме площади и периметра)
я подумал что если он будет уметь конвертировать линии в один регион и обратно то все получится.
регион годится толко для подсчетов - работать с секцией которая в регион не возможно

----- добавлено через ~23 ч. -----
есть тут кто?
может подскажете что нибудь из того что я спросил выше?

15.04.2015, 08:00		#1
Написание Lisp для вычленение информации из massprop и вставки ее в текст модели Тропок Регистрация: 23.05.2008 Сообщений: 7 Дорого времени суток, очень нужно написать lisp по средствам которого можно вычленить значение mass из команды massprop и вставить, полученное значение в multi text.
Просмотров: 3888

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Пакетная печать множества рамок (форматов) из пространства модели.	maratovich	AutoCAD	410	23.08.2023 16:17
LISP. Вставка в таблицу поля, соотвествующего площади примитива	Profan	Готовые программы	272	06.06.2021 23:12
LISP. Как выбрать из текст на модели AutoCAD 2009/2012 число?	yuryx	LISP	16	13.04.2012 11:35

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