Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Программы » Autodesk AutoCAD (часть 2)

Модерирует : gyra, Maz

 Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

Открыть новую тему     Написать ответ в эту тему

kpblc

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
(vl-load-com)
 
(defun c:ent2pt (/ adoc selset)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (= (type
           (setq selset
                  (vl-catch-all-apply
                    (function
                      (lambda ()
                        (ssget
                          "_:L"
                          '((0 . "ARC,CIRCLE,ELLIPSE,*TEXT,HATCH,INSERT")
                            )
                          ) ;_ end of ssget
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
           ) ;_ end of type
         'pickset
         ) ;_ end of =
    (foreach ent
                 (mapcar (function entget)
                         ((lambda (/ tab item)
                            (repeat (setq tab  nil
                                          item (sslength selset)
                                          ) ;_ end setq
                              (setq
                                tab (cons (ssname selset (setq item (1- item)))
                                          tab
                                          ) ;_ end of cons
                                ) ;_ end of setq
                              ) ;_ end of repeat
                            ) ;_ end of lambda
                          )
                         ) ;_ end of mapcar
      (entmakex
        (append
          (list
            '(0 . "POINT")
            (cons 10
                  (cond
                    ((member (cdr (assoc 0 ent))
                             '("ARC" "CIRCLE" "INSERT" "MTEXT" "ELLIPSE")
                             ) ;_ end of member
                     (trans (cdr (assoc 10 ent)) (cdr (assoc 210 ent)) 0)
                     )
                    ((= (cdr (assoc 0 ent)) "HATCH")
                     ((lambda (/ minp maxp)
                        (vla-getboundingbox
                          (vlax-ename->vla-object (cdr (assoc -1 ent)))
                          'minp
                          'maxp
                          ) ;_ end of vla-getboundingbox
                        (mapcar '(lambda (a b) (* (+ a b) 0.5))
                                (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of mapcar
                        ) ;_ end of lambda
                      )
                     )
                    ((= (cdr (assoc 0 ent)) "TEXT")
                     (trans (cdr (assoc
                                   (if (or (not (cdr (assoc 72 ent)))
                                           (not (member (cdr (assoc 72 ent)) '(0 3 5)))
                                           ) ;_ end of or
                                     11
                                     10
                                     ) ;_ end of if
                                   ent
                                   ) ;_ end of assoc
                                 ) ;_ end of cdr
                            (cdr (assoc 210 ent))
                            0
                            ) ;_ end of trans
                     )
                    ) ;_ end of cond
                  ) ;_ end of cons
            ) ;_ end of list
          (vl-remove-if-not
            (function
              (lambda (x)
                (cdr x)
                ) ;_ end of lambda
              ) ;_ end of function
            (mapcar (function (lambda (x) (assoc x ent)))
                    '(210 8 67 6 62 410 62 370 48 420 440 430)
                    ) ;_ end of mapcar
            ) ;_ end of vl-remove-if-not
          ) ;_ end of append
        ) ;_ end of entmakex
      (entdel (cdr (assoc -1 ent)))
      ) ;_ end of foreach
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun  

Всего записей: 713 | Зарегистр. 08-08-2003 | Отправлено: 23:48 20-03-2011 | Исправлено: kpblc, 23:50 20-03-2011
Открыть новую тему     Написать ответ в эту тему

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Программы » Autodesk AutoCAD (часть 2)


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru