Округление координат кратно значению

baaba · 13.12.2012, 02:35

Часто возникает потребность избавиться от "паразитных" значений при работе над чертежами, когда координаты узловой точки линии могут быть скажем такие:
0.111222,23.999999
что может раздражать, мешать работать (т. к. потом возникают проблемы со штриховками, два миллиметра могут "гулять" по всему проекту). Просмотрел несколько давно существующих похожих тем "округления координат". Однако, потратив около двух часов времени, я так и не нашёл того что мне нужно: утилиту для округления координат узловых точек примитивов чертежа скажем кратно 5 мм, что достаточно для строительства. Пришлось потратить ещё 4 часа и вот что у меня получилось:

Код:

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

; The program rounds the values x, y, z coordinates of the point of the lines, polylines,
; circles, multiply the specified value.
; Radius, coordinates community centers also become multiple setpoint.
; This can be avoided in the drawings of the coordinates of the form 150.0989,
; do say multiple dimensions of 5 mm, which is sufficient for construction drawings.

; Программа округляет значения x, y, z координат узловых точке отрезков,
; полилиний, кругов кратно заданному значению.
; Радиусы, координаты центров кругов так же становятся кратными заданному значению.
; Этим можно избежать в чертежах значений координат вида: 150.0989,
; сделать все размеры кратными скажем 5 мм, что достаточно для
; строительных чертежей

(defun rn (num w)
	(* (atof (rtos (/ num w) 2 0)) w)
)

(defun rn1 (lst w)
	(if (or
			(eq 10 (car lst))
			(eq 11 (car lst))
			(eq 40 (car lst))
		)

		(if (listp (cdr lst))
			(cons 
				(car lst)
				(mapcar '(lambda (x) (rn x w)) (cdr lst))
			)
			(cons (car lst) (rn (cdr lst) w))
		)
		lst
	)
)

(defun c:rnd (/ ss w cnt inent)
	(setq
		w (getreal "Enter the value to which the round: ")
		ss (ssget)
		cnt 0
	)
	(while (setq inent (entget (ssname ss cnt)))
		(progn
			(entmod (mapcar '(lambda (x) (rn1 x w)) inent))	
			(setq cnt (1+ cnt))		
		)
	)
	(princ)
)
(princ "type: \"RND\"")
(princ)

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

Может быть кому-нибудь пригодится!
=================================================
PS Вопрос модераторам форума:
попробовал скопировать текст программы. При вставке получаются номера строк (я пользовался тегом LISP). Такой код неработоспособен. Обычным notepad это трудно исправить. По-этому я добавляю вложение, использую тег [code] вместо [code] + [lisp].
Предлагаю исправить тег LISP так что бы не показывались номера строк, или при "выделить всё" они не выделялись.

hwd · 14.12.2012, 14:18

Цитата:

Часто возникает потребность избавиться от "паразитных" значений при работе над чертежами, когда координаты узловой точки линии могут быть скажем такие:
0.111222,23.999999

Если будешь чертить, а не рисовать, то и проблем таких не будет.

Цитата:

Однако, потратив около двух часов времени, я так и не нашёл того что мне нужно: утилиту для округления координат узловых точек примитивов чертежа скажем кратно 5 мм, что достаточно для строительства. Пришлось потратить ещё 4 часа и вот что у меня получилось

Бесполезное и вредное велосипедостроение. Плохо искал.

Кулик Алексей aka kpblc · 14.12.2012, 14:19

hwd, показ координат и размеров - одно, а их истинные значения - совсем другое

Ты ж сам в курсе

))

hwd · 14.12.2012, 14:25

Цитата:

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

hwd, показ координат и размеров - одно, а их истинные значения - совсем другое

Ты ж сам в курсе

))

да один хрен - обновил скрин для коодинат (настройки ведь идентичны). Используя "родное" округление не теряется связь с фактическим значением размеров, а "перенабивание" убивает её.

UPD а блин

))) Я неправильно понял автора... Он округляет координаты точек примитивов, а не снимаемые с них размеры... Тогда звиняюсь...

Do$ · 14.12.2012, 14:46

Цитата:

; Программа округляет значения x, y, z координат узловых точке отрезков,
; полилиний, кругов кратно заданному значению.

Какой-то явно неполный список, судя по:

Цитата:

ss (ssget)

baaba · 15.12.2012, 17:15

Цитата:

Сообщение от Do$

ss (ssget)

Стоило бы добавить фильтры на ssget?

Кулик Алексей aka kpblc · 15.12.2012, 20:34

Цитата:

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

Вопрос модераторам форума:
попробовал скопировать текст программы. При вставке получаются номера строк (я пользовался тегом LISP). Такой код неработоспособен. Обычным notepad это трудно исправить. По-этому я добавляю вложение, использую тег [code] вместо [code] + [lisp].

https://www.youtube.com/watch?v=wFKc6EfRofo
Касательно кода, как альтернативный вариант:

Код:

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

 (vl-load-com)

(defun c:roundval (/ adoc selset value round _kpblc-conv-selset-to-enam _kpblc-ent-modify-autoregene)

  (defun _kpblc-ent-modify-autoregen (ent bit value ext_regen / ent_list old_dxf new_dxf layer_dxf70)
                                     ;|
*    Функция модификации указанного бита примитива
*    Параметры вызова:
*	entity	- примитив, полученный через (entsel), (entlast) etc
*	bit	- dxf-код, значение которого надо установить
*	value	- новое значение
*	regen	- выполнять или нет регенерацию примитива сразу. t/ nil
*    Примеры вызова:
(_kpblc-ent-modify-autoregen (entlast) 8 "0" t)	; перенести последний примитив на слой 0
(_kpblc-ent-modify-autoregen (entsel) 62 10 nil)	; установить выбранному примитиву цвет 10
*    Возвращаемое значение:
*	примитив с модифицированным dxf-списком. Примитив перерисовывается в
* зависимости от значения ключа ext_regen
|;
    (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
          ;(_KPBLC-LIST-ADD-OR-SUBST ent_list bit (cdr new_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-conv-selset-to-ename (selset / tab item)
                                     ;|
*    Преобразование набора, полученного через ssget, в список ename-представлени
* примитивов.
*    Параметры вызова:
	selset	набор примитивов
*    Примеры вызова:
(_kpblc-conv-selset-to-ename (ssget))
|;
    (cond
      ((not selset) nil)
      ((= (type selset) 'pickset)
       (repeat (setq tab  nil
                     item (sslength selset)
                     ) ;_ end setq
         (setq tab (cons (ssname selset (setq item (1- item))) tab))
         ) ;_ end repeat
       )
      ((listp selset) selset)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun round (value precision)
;;; http://forum.dwg.ru/showthread.php?t=21977
    ;|Функция (round число <точность округления>)
Аргумент ЧИСЛО округляется в зависимости от значения аргумента <точность округления>
Примеры вызова:
(round 126.643 0.1) 126.6 
(round 126.663 0.1) 126.7
(round 126.243 0.5) 126.0
(round 126.643 0.5) 126.5
(round 126.843 0.5) 127.0
(round 126.443 1) 126
(round 126.543 1) 127
(round 122.343 5) 120
(round 122.843 5) 125
(round 126.843 5) 125
(round 127.843 5) 130
Ну и т.д.
|;
    ((lambda (x)
       (if (apply '<= (list (rem x 1.) 0.5))
         (* (fix x) precision)
         (+ (* (fix x) precision) precision)
         ) ;_ end of if
       ) ;_ end of lambda
      (apply '/ (mapcar 'float (list value precision)))
      )
    ) ;_ end of defun

  (if (and (= (type (setq value (vl-catch-all-apply
                                  (function
                                    (lambda ()
                                      (initget 7)
                                      (getreal "\nEnter round value <Cancel> : ")
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'real
              ) ;_ end of =
           (= (type (setq selset (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (ssget "_:L" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           ) ;_ end of and
    (progn
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (foreach item (_kpblc-conv-selset-to-ename selset)
        (foreach dxf '(10 11 40)
          (if (member dxf (mapcar (function car) (entget item)))
            (_kpblc-ent-modify-autoregen item
                                         dxf
                                         (mapcar
                                           (function
                                             (lambda (x)
                                               (round x value)
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                           (cdr (assoc dxf (entget item)))
                                           ) ;_ end of mapcar
                                         nil
                                         ) ;_ end of _kpblc-ent-modify-autoregen
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of foreach
      (vla-regen adoc acactiveviewport)
      (vla-endundomark adoc)
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

---
Добавлено: хоть отпишитесь - работает аль посылает в неизвестном направлении?

getr · 21.12.2012, 10:49

есть еще информация по ссылке- http://forum.dwg.ru/showthread.php?t=8019&page=2

baaba · 22.12.2012, 00:45

Цитата:

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

есть еще информация по ссылке- http://forum.dwg.ru/showthread.php?t=8019&page=2

у меня это к сожалению не заработало, я начал с этой ссылки.

bernata · 25.01.2013, 14:12

кстати... код по ссылке работает.
baaba-> попробуй сохранить с кодировкой не в *unicod, а в *ANSI, и поставь точкус запятой перед строкой, как советуют вот здесь.
После чего надо перезагрузить файл round-coord.lsp

RNB · 06.02.2014, 14:51

Цитата:

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

Касательно кода, как альтернативный вариант:

Команда: ROUNDVAL
Enter round value <Cancel> : 10
Выберите объекты: найдено: 1
Выберите объекты: ; ошибка: неверный тип аргумента: listp 0.0

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

Цитата:

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

rnd.zip (694 байт, 39 просмотров)

Всё работает! Спасибо! В конце выдает ошибку почему-то, но функцию выполняет

Команда: RND
Enter the value to which the round: 10
Выберите объекты: Противоположный угол: найдено: 8
Выберите объекты: ; ошибка: неверный тип аргумента: lentityp nil

kurstep · 28.07.2014, 10:32

А как сделать чтобы координаты выделенных объектов округлялись в системе ПСК координат...? а то Лисп округляет только к Мировой системе

NikolayKotov · Регистрация: 25.10.2007

http://forum.dwg.ru/showpost.php?p=1181382&postcount=36
Можно ли сделать, чтобы программа обрабатывала блоки (статические)?

overband · 14.08.2015, 18:42

Цитата:

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

http://forum.dwg.ru/showpost.php?p=1181382&postcount=36
Можно ли сделать, чтобы программа обрабатывала блоки (статические)?

Присоединяюсь

---------
P.S. Нашел решение. Вот эта программка умеет округлять и точки вставки блоков:
http://experement.spb.ru/wiki/doku.p...inates#скачать

crosandr · 06.03.2016, 15:58

Цитата:

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

Добавлено: хоть отпишитесь - работает аль посылает в неизвестном направлении?

Алексей, расчудесно все работает на отрезках. Вот бы еще точки вставки блоков округлять. Может с 2012 года прогресс ушел вперед в этой части?

gomer · 06.03.2016, 18:10

просто добавить блок в фильтр выбора "*LINE,ARC,CIRCLE,ELLIPSE,INSERT"

KEHT · 31.03.2016, 09:48

Код:

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

 (defun rn1 (lst w)
    (if (or
            (eq 10 (car lst))
            (eq 11 (car lst))
            (eq 40 (car lst))
			(eq 13 (car lst)) ; 1ая размерная линия
			(eq 14 (car lst)) ; 2ая размерная линия
        )
 
        (if (listp (cdr lst))
            (cons
                (car lst)
                (mapcar '(lambda (x) (rn x w)) (cdr lst))
            )
            (cons (car lst) (rn (cdr lst) w))
        )
        lst
    )
)

Если добавить строчки, будет обрабатывать и размеры. Часто бывает начерти или скопировал, образмерил и видишь длины с запятыми (50,122) применяешь RND линии полилинии изменились а размеры(dimension) нет. и остаються нестыковки эти 0,122 или руками править или заново образмеривать. А так добавил две строчки и все впорядке

Миксер · 08.09.2016, 22:22

Кулик Алексей aka kpblc, а можно попросить вас в округление добавить 3dface и 3d полилинии... Очень нужно, а найти нигде не могу

чудик · 08.05.2017, 12:08

Скажите пожалуйста как изменить код, чтобы координаты точки вставки блока округлялись по модулю. Если отрицательное число он его округляет в большую сторону но с учетом знака -139,9 округлить кратно 5 до 135.А нужно чтобы было -140.

skkkk · 09.05.2017, 02:43

чудик, какой хоть код-то? Тот, что в шапке или один из двух других?

чудик · 09.05.2017, 11:51

код от Кулик Алексей aka kpblc, он получается округляет в большую сторону без учета знака. Т.е. 439.69 округлит кратно 5 до 440, если бы было -439.69 округлит кратно 5 до -435, а нужно до -440

Агент СмиТ · 14.02.2018, 14:55

Доброго времени суток!
Кто нибудь сталкивался с необходимостью округления координат вершин такого замечательного примитива как MPolygon?
Перепробовал коды из этой и этой тем, c MPolygon не работают, а "взрывать" каждый примитив до полилиний, округлять и вновь экспортировать в MPolygon неблагодарное занятие

P.s. образец мполигона во вложении, версия файла 2007

VVA · 14.02.2018, 20:16

Цитата:

Сообщение от Агент СмиТ

Перепробовал коды из этой и этой тем, c MPolygon не работают

В #36 замени строку "LWPOLYLINE,LINE,ARC,CIRCLE,POINT,INSERT"
этой "LWPOLYLINE,LINE,ARC,CIRCLE,POINT,INSERT,MPOLYGON"
-------------------------------------
Приведу код полностью

Код:

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

 
(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,MPOLYGON"
             ) ;_ 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

Агент СмиТ · 15.02.2018, 08:50

Цитата:

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

В #36 замени строку "LWPOLYLINE,LINE,ARC,CIRCLE,POINT,INSERT"
этой "LWPOLYLINE,LINE,ARC,CIRCLE,POINT,INSERT,MPOLYGON"
-------------------------------------

VVA, благодарю за ответ! Код работает как нужно, одельно порадовала возможность обработки нескольких предварительно выбранных объектов.

Offtop: Понимаю, что выглядит несколько нагловато, но есть ли возможность добавить MPolygon в код ECoorE, уверен многие пользователи Map3D будут благодарны за это!

VVA · 15.02.2018, 16:43

Агент СмиТ, Offtop: MPolygon добавил http://forum.dwg.ru/showthread.php?p=244237#post244237

golotvin · 13.02.2019, 17:03

Ребят, а всё в порядке с кодов в #23? У всех всё именно округляется? Или это у меня лыжи не едут?
Округлить необходимо до 3-х знаков.
Пример до и после "округления" привожу.
Версия ПО Civil3D 2015

AlexCondor · 13.02.2019, 17:21

Вроде все работает. Что вы вводите на запрос: Значение округления координат <Приводить к целым>?

golotvin · 13.02.2019, 17:26

1.111
На другое она вроди не гукается

AlexCondor · 13.02.2019, 17:28

Введите 0.001

golotvin · 13.02.2019, 17:32

Спасибо!
Наверное перетрудился....

golotvin · 14.02.2019, 00:16

Н-да! Как там говорил классик: "Или я поведу её в ЗАГС, или она поведёт меня к прокурору!"
А кто-то баловался активно с MPolygon-ами? Может быть Агент СмиТ?
Округляет. Близко. Очень близко. Но чуть-чуть не считается....
Пример привожу. Там МПолигоны. Голым Кадом посмотреть не получится
ПО то же Civil3D 2015

AlexCondor · 14.02.2019, 10:30

От классиков: "Не смешите мои тапочки!"
Голый AutoCAD. Округляет очень даже точно. Во вложении до 0.01...

golotvin · 14.02.2019, 12:10

Ну если голый AutoCAD видит мэйповские полигоны это просто прекрасно. Вопрос не в том.
Где "очень даже точно"? Сравните хоть бы две левые вершины исходного полигона и Вашего.

AlexCondor · 14.02.2019, 12:57

А если попробовать округлять до 0.0005.
P.S. А потом уже до 0.001

golotvin · 14.02.2019, 13:26

Попробовал тогда оно в эти 0,0005 и не бьет с контрольной полилинией.
А если потом прогнать до 0,001 то коверкаются вершины с координатами типа 0,5360 на эту самую тысячную. С полилинией такого не происходит.
По видимому МПолигон, зараза, имеет более замудрённые свойства.
Придётся, наверное, их создавать после округления полилиний. Ну хоть с ними проблем нет. Все вершины округляются однозначно и топология перестраивается без ругани. И на том спасибо.
Но жаль....

peshkoff · 15.05.2019, 12:42

Стандартных средств не появилось? ACAD LT...

Артём Ухов · 24.11.2021, 16:40

Помог способ, описанный на форуме:
https://forums.autodesk.com/t5/autoc...e/td-p/8827691
https://www.cadforum.cz/en/qaID.asp?tip=6065

Moi Imena · 12.12.2021, 08:28

Цитата:

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

Приведу код полностью

День добрый, от чего такие кроказябры при использовании кода ? И как это можно исправить ?

koMon · 14.12.2021, 11:43

Цитата:

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

Но жаль....

без проверок в модели.

shartal · 15.12.2021, 11:41

Цитата:

от чего такие кроказябры

Сохранять надо в кодировке ANSI

Moi Imena · 17.12.2021, 05:30

Цитата:

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

Сохранять надо в кодировке ANSI

спасибо, помогло

inessarazum · 10.08.2022, 13:14

Здравствуйте. Помогите, пожалуйста, сделать этот код для 3д полилиний, чтобы округлял координаты XYZ

ant_bar · 27.04.2023, 12:15

День добрый!
Коллеги, два вопроса:
Можно как-то исправить код, чтобы программа не меняла размеры окружностей, а только координату точки вставки (если ставлю округление "100", то и радиусы под это округляются - наверное из-за ручек)?

Цитата:

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

В #36 замени строку "LWPOLYLINE,LINE,ARC,CIRCLE,POINT,INSERT"
этой "LWPOLYLINE,LINE,ARC,CIRCLE,POINT,INSERT,MPOLYGON"

Можно ли этот код использовать для эллипсов (даже центр эллипса не смещается почему-то)? Или с ними математика не такая?

VVA · 02.05.2023, 13:34

Цитата:

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

ожно как-то исправить код, чтобы программа не меняла размеры окружностей, а только координату точки вставки (если ставлю округление "100", то и радиусы под это округляются - наверное из-за ручек)?

Найди строку

Цитата:

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

и удали цифру 40 (dxf код радиуса)

Цитата:

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

Можно ли этот код использовать для эллипсов (даже центр эллипса не смещается почему-то)? Или с ними математика не такая?

Можно, добавить "LWPOLYLINE,LINE,ARC,CIRCLE,POINT,INSERT,MPOLYGON,ELLIPSE" и исключить радиус

Код:

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

 (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,MPOLYGON,ELLIPSE"
             ) ;_ end of wcmatch
             (entmod
               (mapcar
                 '(lambda (x)
                    (if (member (car x) '(10 11)) ;_ (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

mya · 13.09.2024, 11:36

здравствуйте, а можно добавить сюда объекты спдс? В частности стены, колонны. У них в свойствах координата точки вставки не отображена, вручную не получается перебить, только двигать руками.

baaba · 24.04.2025, 12:48

Получил переработанную программу с помощью больших лингвистических моделей. Что изменилось:

добавлена возможность работы в любой ПСК
добавлена отмена одной командой
оптимизирован код по производительности на больших фалах процентов на 25
добавлена лицензия, инструкция как запустить, упоминание помогавших

На счёт объектов СПДС - не знаю, не могу к сожалению. Попробуйте чат ДЖПТ

Вот рабочий вариант:

Код:

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

 ;https://chat.deepseek.com/a/chat/s/2fc203cd-9e89-45bc-af65-208318facac0
;| rnd.lsp - Округление координат и размеров в UCS
   Copyright (c) 2025 Ivan Rodionov, Grok (xAI), OpenAI, AI Assistant (DeepSeek Chat)
   MIT License: свободное использование, сохранение копирайта
   Авторы:
   - Ivan Rodionov: идея, первые версии
   - ChatGPT (OpenAI): ранние оптимизации
   - Grok (xAI): фильтр, производительность, UCS
   - AI Assistant (DeepSeek Chat): исправление ошибок, интерфейс, значение по умолчанию
   - xAI: поддержка Grok
   Описание:
   Округляет координаты и размеры объектов в UCS с шагом (по умолчанию 5).
   Использование:
   1. Загрузить: (load "rnd")
   2. Установить UCS (если нужно)
   3. Команда: RND → Enter (шаг=5) или ввести свой шаг |;

Обсуждение: http://forum.dwg.ru/showthread.php?t=92362

(command "_UNDO" "_BE")

; Округляет число до кратного w (к ближайшему)
(defun round-number (num w)
    (* (float (fix (+ (/ num w) 0.5))) w))

; Округляет координаты (x y z)
(defun round-point (pt w)
    (mapcar '(lambda (x) (round-number x w)) pt))

; Обрабатывает DXF-группу
(defun round-dxf (lst w cnt / wcs-pt ucs-pt rounded-ucs-pt)
    (if (member (car lst) '(10 11))
        (progn
            (setq wcs-pt (cdr lst)
                  ucs-pt (trans wcs-pt 0 1)
                  rounded-ucs-pt (round-point ucs-pt w))
            (cons (car lst) (trans rounded-ucs-pt 1 0)))
        (if (member (car lst) '(40 41 42))
            (cons (car lst) (round-number (cdr lst) w))
            lst)))

; Основная команда (значение по умолчанию = 5)
(defun c:rnd (/ ss w cnt start-time end-time default-val)
    (setq default-val 5.0) ; Значение по умолчанию
    (princ (strcat "\nТекущий UCS: " (if (getvar "UCSNAME") (getvar "UCSNAME") "World")))
    (initget 6) ; Запрет нуля и отрицательных чисел
    (setq w (getreal (strcat "\nВведите шаг округления <" (rtos default-val) ">: ")))
    (if (not w) (setq w default-val)) ; Если Enter - подставляем default-val
    (setq ss (ssget '((0 . "LINE,POLYLINE,LWPOLYLINE,CIRCLE,ARC"))))
    (if (not ss)
        (princ "\nОбъекты не выбраны!")
        (progn
            (setq cnt 0
                  start-time (getvar "MILLISECS"))
            (repeat (sslength ss)
                (entmod (mapcar '(lambda (x) (round-dxf x w cnt)) (entget (ssname ss cnt))))
                (setq cnt (1+ cnt)))
            (princ (strcat "\nОбработано объектов: " (itoa cnt)))
            (princ (strcat "\nВремя: " (rtos (/ (- (getvar "MILLISECS") start-time) 1000.0) 2 3) " сек"))))
    (princ))

(princ "\nКоманда: RND (округляет координаты в UCS, шаг по умолчанию=5)")
(princ)

(command "_UNDO" "_END")

baaba · 25.04.2025, 00:35

В общем это всё скорее относится к работе с подосновой. У меня теперь есть наработка на Python, которая с помощью OpenCV (машинное зрение, библиотека) и ezdxf (Пайтон не может работать с DWG, пока) обводит оборудование. У меня были проблемы вставки в Revit. Я бы это всё как то интегрировал к теме подготовки подосновы. Думаю многим будет полезно. Оборудование у меня было в PDF, но он был - векторный, был выгружен из САПР, к сожалению с большим количеством мусора. Очень жаль что люди ленятся передать нормальный материал, с которым можно легко работать. К сожалению такова специфика моей работы. Но может оно и к лучшему.

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

Цитата:

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

здравствуйте, а можно добавить сюда объекты спдс? В частности стены, колонны. У них в свойствах координата точки вставки не отображена, вручную не получается перебить, только двигать руками.

По скольку я не пользуюсь SPDS объектами да и со временем напряжёнка предлагаю Вам взять мой последний код и закинуть в чат-бот. Думаю Вы без моей помощи сможете сами дожать. Пробуйте разные, Дипсик, Квен, ЧатДЖПТ, Грог. Шлите им ошибки. Должно получиться. Будет у Вас рабочий вариант под ваши задачи.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Округление координат, полилиний, центров окружностей, блоков	MA2	Программирование	44	15.01.2015 15:19
округление подписей координат в атрибутах блока	АлексЮстасу	AutoCAD	4	19.07.2010 13:35
Помощь по Лире	Серега М	Лира / Лира-САПР	52	28.05.2007 02:47
управление системой координат Автокад из Делфей	Владимир В	Программирование	12	27.04.2005 09:54