[baaba]

Часто возникает потребность избавиться от "паразитных" значений при работе над чертежами, когда координаты узловой точки линии могут быть скажем такие:
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 так что бы не показывались номера строк, или при "выделить всё" они не выделялись.

[Moi Imena]

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

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

[inessarazum]

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

[ant_bar]

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

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

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

[VVA]

Сообщение от 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]

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

[baaba]

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

• добавлена возможность работы в любой ПСК
• добавлена отмена одной командой
• оптимизирован код по производительности на больших фалах процентов на 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]

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

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

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

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