[megabeton]

Есть необходимость привести координаты всех точек чертежа автокада к одному модулю, например 1 метр или милиметр (неважно). Чертеж начерчен "кривыми" руками с размерами линий типа "2351,9613591" - причем все размеры линий такого "некруглого" плана. Решать проблему понижением точности чертежа или размеров очень не хочется, т.к. со временем начнут вылезать ненужные (ошибочные) округления и сумма размеров в цепи не даст правильного общего размера.
По моему было бы очень удобно из архитектурных чертежей (тех же планов), начерченных "на глаз" быстро делать точные чертежи для конструктива.

Возможно ли решение такой проблемы средствами автокада, лиспом или сторонними программами?

[Profan]

Что, архитекторы чертят в AutoCAD'е "на глаз"? Уволить таких архитекторов.

[hwd]

Сообщение от megabeton По моему было бы очень удобно из архитектурных чертежей (тех же планов), начерченных "на глаз" быстро делать точные чертежи для конструктива.

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

[VVA]

Округление координат объектов

[megabeton]

VVA, СУПЕР ГРАНД МЕРСИ !!!
То что надо - конец кривым рукам архитекторов )))
P.S. VVA и kpblc просто Боги програмирования

[Frandibola]

Сообщение от VVA Округление координат объектов

Тоже понадобилось исправить кривые чертежи архитекторов, но по ссылке от V V A, lisp в 2011 Акаде не работает, да и форум там от 2005 года... а тема- то актуальная, постоянно приходится биться с архитекторами.
Может кто разбирается в Lisp'e и сможет подправить код, чтоб пахал на 2011 или более поздних версиях Акада?
с меня бутылка

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

Проверил на ACAD2014. Возможно, возникла проблема при копировании лиспа. <...> Удалил.

----- добавлено через ~7 мин. -----
Добавлю: попробуй такой код

Код:

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

 (defun c:round-coord (/                        _kpblc-eval-nearest      _kpblc-ent-modify-autoregen
                      _kpblc-conv-list-to-2dpoints                      lst
                      round                    err
                      )

  (defun _kpblc-conv-list-to-2dpoints (lst / res)
    (cond
      ((not lst)
       nil
       )
      (t
       (setq res (cons (list (car lst)
                             (if (cadr lst)
                               (cadr lst)
                               0.
                               ) ;_ end of if
                             ) ;_ end of list
                       (_kpblc-conv-list-to-2dpoints (cddr lst))
                       ) ;_ end of cons
             ) ;_ end of setq
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (defun _kpblc-ent-modify-autoregen (ent bit value ext_regen / ent_list old_dxf new_dxf layer_dxf70)
    (if (not
          (and
            (or
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
              (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
              ) ;_ end of or
            (= bit 100)
            ) ;_ end of and
          ) ;_ end of not
      (progn
        (setq ent_list (entget ent)
              new_dxf  (cons bit
                             (if (and (= bit 62) (= (type value) 'str))
                               (if (= (strcase value) "BYLAYER")
                                 256
                                 0
                                 ) ;_ end of if
                               value
                               ) ;_ end of if
                             ) ;_ end of cons
              ) ;_ end of setq
        (if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
          (progn
            (entmod (if old_dxf
                      (subst new_dxf old_dxf ent_list)
                      (append ent_list (list new_dxf))
                      ) ;_ end of if
                    ) ;_ end of entmod
            (if ent_regen
              (entupd ent)
              (redraw ent)
              ) ;_ end of if
            ) ;_ end of progn
          ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
    ent
    ) ;_ end of defun

;;;*    Получение "ближайшего" к указанному числу из списка
;;;*    Параметры вызова:
;;;*  value  контрольное значение
;;; *  lst  список "проверяемых" значений
  (defun _kpblc-eval-nearest (value lst / x base)
    (if lst
      (progn
        (setq x    (car lst)
              base (abs (- value x))
              ) ;_ end of setq
        (foreach item (cdr lst)
          (if (> base (abs (- value item)))
            (setq x    item
                  base (abs (- value item))
                  ) ;_ end of setq
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of progn
      (setq x value)
      ) ;_ end of if
    x
    ) ;_ end of defun

  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (if (not (vl-catch-all-error-p
             (setq round (vl-catch-all-apply
                           (function
                             (lambda ()
                               (cond
                                 ((getreal "\nЗначение округления координат <Приводить к целым> : "))
                                 (t 1.)
                                 ) ;_ end of cond
                               ) ;_ end of lambda
                             ) ;_ end of function
                           ) ;_ end of vl-catch-all-apply
                   ) ;_ end of setq
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
    (progn
      (foreach ent
                   (vl-remove-if 'listp
                                 (mapcar 'cadr (ssnamex (ssget "_:L")))
                                 ) ;_ end of vl-remove-if
        (if (vl-catch-all-error-p
              (setq err (vl-catch-all-apply
                          (function
                            (lambda ()
                              (cond
                                ((member (cdr (assoc 0 (entget ent))) '("POINT" "INSERT"))
                                 (_kpblc-ent-modify-autoregen
                                   ent
                                   10
                                   (mapcar '(lambda (x)
                                              (_kpblc-eval-nearest
                                                x
                                                (list (* round (fix (/ x round)))
                                                      (* round (1+ (fix (/ x round))))
                                                      ) ;_ end of list
                                                ) ;_ end of _kpblc-eval-nearest
                                              ) ;_ end of lambda
                                           (cdr (assoc 10 (entget ent)))
                                           ) ;_ end of mapcar
                                   t
                                   ) ;_ end of _kpblc-ent-modify-autoregen
                                 )
                                ((member (cdr (assoc 0 (entget ent))) '("ARC" "CIRCLE"))
                                 (mapcar
                                   '(lambda (y)
                                      (_kpblc-ent-modify-autoregen
                                        ent
                                        y
                                        ((lambda (/ res)
                                           (setq res
                                                  (mapcar '(lambda (x)
                                                             (_kpblc-eval-nearest
                                                               x
                                                               (list (* round (fix (/ x round)))
                                                                     (* round (1+ (fix (/ x round))))
                                                                     ) ;_ end of list
                                                               ) ;_ end of _kpblc-eval-nearest
                                                             ) ;_ end of lambda
                                                          (if (= (type (cdr (assoc y (entget ent)))) 'list)
                                                            (cdr (assoc y (entget ent)))
                                                            (list (cdr (assoc y (entget ent))))
                                                            ) ;_ end of if
                                                          ) ;_ end of mapcar
                                                 ) ;_ end of setq
                                           (if (/= (type (cdr (assoc y (entget ent)))) 'list)
                                             (setq res (car res))
                                             ) ;_ end of if
                                           res
                                           ) ;_ end of lambda
                                         )
                                        t
                                        ) ;_ end of _kpblc-ent-modify-autoregen
                                      ) ;_ end of lambda
                                   '(10 40)
                                   ) ;_ end of mapcar
                                 ) ;_ end of cond
                                ((= (cdr (assoc 0 (entget ent))) "LINE")
                                 (mapcar '(lambda (y)
                                            (_kpblc-ent-modify-autoregen
                                              ent
                                              y
                                              (mapcar '(lambda (x)
                                                         (_kpblc-eval-nearest
                                                           x
                                                           (list (* round (fix (/ x round)))
                                                                 (* round (1+ (fix (/ x round))))
                                                                 ) ;_ end of list
                                                           ) ;_ end of _kpblc-eval-nearest
                                                         ) ;_ end of lambda
                                                      (cdr (assoc y (entget ent)))
                                                      ) ;_ end of mapcar
                                              t
                                              ) ;_ end of _kpblc-ent-modify-autoregen
                                            ) ;_ end of lambda
                                         '(10 11)
                                         ) ;_ end of mapcar
                                 )
                                ((= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
                                 (vla-put-coordinates
                                   (vlax-ename->vla-object ent)
                                   (vlax-make-variant
                                     (vlax-safearray-fill
                                       (vlax-make-safearray
                                         vlax-vbdouble
                                         (cons 0
                                               (1- (length (setq lst
                                                                  (mapcar
                                                                    '(lambda (x)
                                                                       (_kpblc-eval-nearest
                                                                         x
                                                                         (list (* round (fix (/ x round)))
                                                                               (* round (1+ (fix (/ x round))))
                                                                               ) ;_ end of list
                                                                         ) ; _ end of
                                                                       ) ;_ end of lambda
                                                                    (vlax-safearray->list
                                                                      (vlax-variant-value
                                                                        (vla-get-coordinates
                                                                          (vlax-ename->vla-object ent)
                                                                          ) ;_ end of vla-get-coordinates
                                                                        ) ;_ end of vlax-variant-value
                                                                      ) ;_ end of vlax-safearray->list
                                                                    ) ;_ end of mapcar
                                                                 ) ;_ end of setq
                                                           ) ;_ end of length
                                                   ) ;_ end of 1-
                                               ) ;_ end of cons
                                         ) ;_ end of vlax-make-safearray
                                       lst
                                       ) ;_ end of vlax-safearray-fill
                                     ) ;_ end of vlax-make-variant
                                   ) ;_ end of vla-put-Coordinates
                                 )
                                ) ;_ end of cond
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
              ) ;_ end of vl-catch-all-error-p
          (princ (strcat "\nОшибка при обработке примитива "
                         (cdr (assoc 0 (entget ent)))
                         " : "
                         (vl-catch-all-error-message err)
                         ) ;_ end of strcat
                 ) ;_ end of princ
          ) ;_ end of if
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun

[Frandibola]

Сообщение от Кулик Алексей aka kpblc ----- добавлено через ~7 мин. ----- Добавлю: попробуй такой код

Пробую на ACade 2011, не хочет работать, судя по всему с нумерацией строк по левому краю 001...245. удаляю вручную из тхт

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

Я в свое время делал ролик:

Нажмите для просмотра

http://www.youtube.com/watch?v=wFKc6EfRofo&list=UU1jn1ymHK2jAxsyIg5r799A

[Frandibola]

Спасибо, разобрался с форматированием текста, все заработало.
Огромное спасибо! куда бутылку отправлять?)

[Зодчий1989]

Сообщение от Кулик Алексей aka kpblc Проверил на ACAD2014.

Спасибо огромное. На автокаде 2016 тоже работает.

[megabeton]

А есть возможность докрутить лисп, чтобы при приведении к координатам соблюдалось ортогональность отрезков?
Т.е. точки [к примеру] отрезков не просто перемещались бы к ближайшему модулю, а с учетом того, чтобы отрезки оставались ортогональными относительно пск.