Округление координат, полилиний, центров окружностей, блоков

MA2 · 22.08.2006, 16:40

Не МОГУ БОЛЬШЕ. Помогите. Пришли чертежи от смежной организации, а там большая проблема с привязками. Такое ощущение, что они рисуют на глазок. А привязки не используют совсем. Можно ли это исправить? Я не селен в лиспах, АРХ, но очень хочется воплотить такую идею. Координаты вершин, полилиний или линий, центров окружностей,точки вставок блоков переносились в новое положение, с их округлением (например, 5 мм) в мировой системе координат. Т.е. если координата вершины полилинии имеет (25.0096, -86.1156, 0.0064) чтоб после выполнения программы вершина полилинии центр окружности, или точка вставоки блока, имели такие координаты (25.000, 85.000, 0,000).Спасибо за любой совет

VVA · 28.08.2006, 10:51

Цитата:

А по поводу степени округления координат, мне так и не понятно, возможно это реализовать на лиспе, или нет?

Был в отпуске, поэтому чуть с запозданием.
http://forum.dwg.ru/showthread.php?p=26859#post26859 Alaspher №10
Текст приведу здесь

Код:

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

(defun pl:round (num digit / fact) 
  (setq fact 1.0) 
  (repeat (abs digit) (setq fact (* 10 fact))) 
  (if (minusp digit)(setq fact (/ 1.0 fact))) 
  (setq num (/ (fix (+ (* num fact) 0.5)) fact)) 
  (if (> 1 digit)(fix num) num))

Вырианты:
(pl:round 1234.346 2) -> 1234.35
(pl:round 1234.346 0) -> 1234
(pl:round 1266.346 -1) -> 1270
(pl:round 1266.346 -2) -> 1300

Astartes · 15.10.2010, 11:04

Граждане приветствую. Вот код взятый отсюда http://www.caduser.ru/forum/index.ph...#message173683 и подправленный автором, скинул мне через личку, но у меня все равно не работает. Кто подскажет в чем дело.
Никакого округления не происходит. Как были координаты со знаками после запятой так они и остаются.
Никаких ошибок при выполение команды не происходит.
Автокад 2011, русский, леценз.

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

Код:

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

(defun c:round-coord (/                          _kpblc-eval-nearest        _kpblc-ent-modify-autoregen
                      _kpblc-conv-list-to-2dpoints                          lst
                      round
                      )
  (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)
    (setq ent (_kpblc-conv-ent-to-ename ent))
    (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
 
  (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*)
  (cond
    ((setq round
            (getreal "\nЗначение округления координат <Приводить к целым> : ")
           ) ;_ end of setq
     )
    (t (setq round 1.))
    ) ;_ end of cond
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
    (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
               )
             )
            ((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
                       )
                     )
                    t
                    )
                  )
               '(10 40)
               )
             )
            ((= (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-
                           )
                     )
                   lst
                   )
                 )
               )
             )
            )
          )
        )
      )
    )
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun

Лиспер · 15.10.2010, 13:10

Закомментируй строку

Код:

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

(setq ent (_kpblc-conv-ent-to-ename ent))

Этой функции нет, да и не похоже, чтобы была нужна

Astartes · 15.10.2010, 14:32

Лиспер,
А у тебя/вас заработало?
У меня нет. На всякий случай уточню, чтобы закомментировать строку нужно вначале строки поставить // ?

Лиспер · 15.10.2010, 14:35

На "ты" ко мне, если можно.
Комментирование в лиспе - знак ";". Все, что за ним - не обрабатывается. После комментирования строки, про которую я говорил, все сработало на ура

Astartes · 15.10.2010, 14:46

Лиспер, Огромное спасибо тебе. Ну и автору лиспа разумеется.
А в данном лиспе не заложено округление до заданного знака? Или только до целых?

Лиспер · 15.10.2010, 14:54

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

Astartes · 15.10.2010, 15:01

Я просто не совсем понял как задать точность
Команда: ROUND-COORD
Значение округления координат <Приводить к целым> Что здесь написать если я хочу округлить до десятых?
Сори если вопрос тупой ))

Значение округления координат <Приводить к целым>0.1
Так ?

Вроде разобрался ))

Лиспер · 15.10.2010, 15:09

Похоже на то. Я не проверял, надо автора кода ждать

Агент СмиТ · 22.04.2011, 09:59

To Лентяй
Взял код из поста #10, всё работало (у меня AutoCad2011 x64), затем заменил строку из поста #18 изменений вроде не обнаружилось, а вот строка из поста #20 вызвала отказ в исполнении, пишет сообщение: неизвестная команда CrdRndUp.
Но суть вопроса в следующем: можно ли подправить программу, что бы в случае если отбрасываемая часть округляемого числа равна половине предыдущего разряда, то округление производиться до ближайшего четного. Например:
3.75 = 3.8
3.85 = 3.8
Существующий же алгоритм выполняет простое арифметическое округление 3.85 = 3.9
Заранее спасибо!

АлексЮстасу · 05.10.2012, 19:29

Лентяй: программа задачу выполняет, спасибо! Но после нее почему-то резко уменьшилась рабочая область файла. И undo привело к глухому зависанию Автокада.
Еще сюрприз: при вызове программы CrdRndUp в пространстве листа, началось бесконечное ее выполнение, остановить которое удалось только Диспетчером задач.

PsixVK · 09.11.2012, 17:31

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

кстати что такое ординатный размер ГП не вкурсе - нужно самому координатную сетку с чертежом переносить кудой нужно

VVA · 09.11.2012, 22:59

А этот? http://forum.dwg.ru/showthread.php?p=919890#post919890

PsixVK · 12.11.2012, 10:26

Цитата:

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

А этот? http://forum.dwg.ru/showthread.php?p=919890#post919890

в общем тоже самое что и тут в 22-м посте
работает только с линиями, а полилинии и остальное чет отказывается двигать

vl74 · 13.11.2013, 21:11

Да, программа в посте #22 не работает с полилиниями.
Как вариант - сохранять файл в dxf и тупо искать поля с координатами, далее округлять их.

VVA · 14.11.2013, 10:06

Цитата:

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

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

Цитата:

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

Да, программа в посте #22 не работает с полилиниями.

В LW полилинии нельзя через vla-put-coordinates менять сразу все координаты. Это не работает. Работает если обновлять по одной
Немного (процентов на 90

) изменил код #22 Сделал обновление через entmod. Тестировал без фанатизма, должно работать.
PS. Убегаю регистрироваться на Сапряжение.
PPS Если не нужно округлять радиусы, то в строке

Код:

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

(if (member (car x) '(10 11 40)) ;_Начало (10); конец (11); точка вставки (10); радиус (40)

нужно удалить цифру 40

Код:

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

 
(defun c:RC (/ _kpblc-eval-nearest round)
;;;Round-Coord
;;;http://forum.dwg.ru/showthread.php?p=1181242#post1181242
;;;VVA for dwg.ru
  (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 setq
  ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (cond
    ((setq round
            (getreal
              "\nЗначение округления координат <Приводить к целым> : "
            ) ;_ end of getreal
     ) ;_ end of setq
    )
    (t (setq round 1.))
  ) ;_ end of cond
  (foreach ent
           (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:L"))))
    (vl-catch-all-apply
      (function
        (lambda ()
          (cond
            ((wcmatch (cdr (assoc 0 (entget ent)))
                      "LWPOLYLINE,LINE,ARC,CIRCLE,POINT,INSERT"
             ) ;_ end of wcmatch
             (entmod
               (mapcar
                 '(lambda (x)
                    (if (member (car x) '(10 11 40)) ;_Начало; конец; точка вставки; радиус
                      (vl-list*
                        (car x)
                        (if (listp (cdr x))
                          (mapcar
                            '(lambda (y)
                               (_kpblc-eval-nearest
                                 y
                                 (list (* round (fix (/ y round)))
                                       (* round (1+ (fix (/ y round))))
                                 ) ;_ end of list
                               ) ;_ end of _kpblc-eval-nearest
                             ) ;_ end of lambda
                            (cdr x)
                          ) ;_ end of mapcar
                          (_kpblc-eval-nearest
                            (cdr x)
                            (list (* round (fix (/ (cdr x) round)))
                                  (* round (1+ (fix (/ (cdr x) round))))
                            ) ;_ end of list
                          ) ;_ end of _kpblc-eval-nearest
                        ) ;_ end of if
                      ) ;_ end of VL-LIST*
                      x
                    ) ;_ end of if
                  ) ;_ end of lambda
                 (entget ent)
               ) ;_ end of mapcar
             ) ;_ end of entmod
             (entupd ent)
            )
            (t nil)
          ) ;_ end of cond
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of foreach
  (vla-endundomark *kpblc-activedoc*)
  (princ)
) ;_ end of defun

PsixVK · 14.11.2013, 11:21

все прекрасно!
единственно если генпланисты круги рисуют полилиниями - они себя не адекватно ведут, но это мелочь

PsixVK · 10.12.2013, 15:51

здравствуйте
возник вопрос
а можно как то сделать так что бы припустим все линии и полинии были строго вертикально и строго горизонтально друг к другу и относительно МСК
для чего: припустим есть у нас генеральный план (реконструкция) там все сети, здания сделаны абы как под разными углами друг к другу. нужно с этого чуда сделать принципиальную схему тоесть сделать все упрощенно и ровненько (горизонтально и вертикально)
буду очень благодарен

Дима_ · 10.12.2013, 17:08

Код:

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

 (vl-load-com)
(defun c:rovno()
  ((lambda (p-pt doc lst)
     (vla-startundomark doc)
     (mapcar
       '(lambda (ent)
           (if (= (cdr (assoc 0 ent)) "LINE")
               (entmod (subst (cons 11 (apply 'p-pt (mapcar '(lambda (x) (cdr (assoc x ent))) '(10 11))))
                       (assoc 11 ent)
                       ent))
               ((lambda (frec) (entmod (frec (cdr (assoc 10 ent)) ent)))
                (lambda (pt lst)
                  (if lst (if (= (caar lst) 10)
                              ((lambda (pt) (cons (cons 10 pt) (frec pt (cdr lst))))
                               (p-pt pt (cdar lst)))
                              (cons (car lst) (frec pt (cdr lst)))))))))
       lst)
       (vla-endundomark doc))
   (lambda (pt1 pt2);p-pt - кладет на ближайшую ось
     (if (apply '> (mapcar 'abs (apply 'mapcar (cons '- (mapcar '(lambda (x) (list (car x) (cadr x))) (list pt1 pt2))))))
         (list (car pt2) (cadr pt1))
         (list (car pt1) (cadr pt2))))
   (vla-get-activedocument (vlax-get-acad-object))
   (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*LINE")))))))))

Как выравнивать последний сегмент замкнутой полилинии - я не придумал, доделывать не буду (разминка).

Dant · 10.12.2013, 17:44

Проверял в AutoCAD 2011. И CrdRndUp и РС прекрасно работают

. Единственное замечание - выносные размерные линии остаются с прежними координатами. Получается, что все размеры нужно вытирать и проставлять по новой, иначе выносные не совпадают с объектом образмеривания. Может уже и это можно подправить? Тогда действительно этим функциям цены не будет.

22.08.2006, 16:40
Округление координат, полилиний, центров окружностей, блоков MA2 Москва Регистрация: 22.08.2006 Сообщений: 9 Не МОГУ БОЛЬШЕ. Помогите. Пришли чертежи от смежной организации, а там большая проблема с привязками. Такое ощущение, что они рисуют на глазок. А привязки не используют совсем. Можно ли это исправить? Я не селен в лиспах, АРХ, но очень хочется воплотить такую идею. Координаты вершин, полилиний или линий, центров окружностей,точки вставок блоков переносились в новое положение, с их округлением (например, 5 мм) в мировой системе координат. Т.е. если координата вершины полилинии имеет (25.0096, -86.1156, 0.0064) чтоб после выполнения программы вершина полилинии центр окружности, или точка вставоки блока, имели такие координаты (25.000, 85.000, 0,000).Спасибо за любой совет
Просмотров: 24128

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

	Реклама i