| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Округление координат, полилиний, центров окружностей, блоков

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

Закрытая тема
Поиск в этой теме
Непрочитано 22.08.2006, 16:40 #1
Округление координат, полилиний, центров окружностей, блоков
MA2
 
Москва
Регистрация: 22.08.2006
Сообщений: 9

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


 
Регистрация: 22.08.2006
Москва
Сообщений: 9


Все что я смог найти это такой код программы, от господина kpblc (defun c:round-coord (/ selset item x_round y_round z_round point vla_point)

(vl-load-com)
(if (not *kpblc-activedoc*)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of if
(vla-startundomark *kpblc-activedoc*)
(setq counter 0
selset (ssget '((0 . "POINT")))
) ;_ end of setq
(if selset
(progn
(setq x_round (getint "\nКоличество знаков после запятой для X <0> : "))
(if (not x_round)
(setq x_round 0)
(setq x_round (abs x_round))
) ;_ end of if
(setq
y_round (getint (strcat "\nКоличество знаков после запятой для Y <"
(itoa x_round)
"> : "
) ;_ end of strcat
) ;_ end of getint
) ;_ end of setq
(if (not y_round)
(setq y_round x_round)
(setq y_round (abs y_round))
) ;_ end of if
(setq
z_round (getint (strcat "\nКоличество знаков после запятой для Z <"
(itoa x_round)
"> : "
) ;_ end of strcat
) ;_ end of getint
) ;_ end of setq
(if (not z_round)
(setq z_round x_round)
(setq z_round (abs z_round))
) ;_ end of if
(while (and selset
(> (sslength selset) 0)
) ;_ end of and
(setq item (ssname selset 0))
(ssdel item selset)
(setq item (vlax-ename->vla-object item)
point (vlax-safearray->list
(vlax-variant-value (vla-get-coordinates item))
) ;_ end of vlax-safearray->list
vla_point (vlax-make-safearray vlax-vbdouble '(0 . 2))
) ;_ end of setq
(vlax-safearray-fill
vla_point
(list (atof (rtos (car point) 2 x_round))
(atof (rtos (cadr point) 2 y_round))
(atof (rtos (caddr point) 2 z_round))
) ;_ end of list
) ;_ end of vlax-safearray-fill
(vla-put-coordinates item vla_point)
) ;_ end of while
) ;_ end of progn
) ;_ end of if
(vla-regen *kpblc-activedoc* acallviewports)
(vla-endundomark *kpblc-activedoc*)
) ;_ end of defun

но он только для точек, может, кто поможет на основании его сделать выравнивание вершин для полилиний, линий, центров окружностей, и точек вставок блоков
MA2 вне форума  
 
Непрочитано 23.08.2006, 03:12 Re: Округление координат, полилиний, центров окружностей, бл
#3
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от MA2
Не МОГУ БОЛЬШЕ. Помогите. Пришли чертежи от смежной организации, а там большая проблема с привязками. Такое ощущение, что они рисуют на глазок. А привязки не используют совсем. Можно ли это исправить? Я не селен в лиспах, АРХ, но очень хочется воплотить такую идею. Координаты вершин, полилиний или линий, центров окружностей,точки вставок блоков переносились в новое положение, с их округлением (например, 5 мм) в мировой системе координат. Т.е. если координата вершины полилинии имеет (25.0096, -86.1156, 0.0064) чтоб после выполнения программы вершина полилинии центр окружности, или точка вставоки блока, имели такие координаты (25.000, 85.000, 0,000).Спасибо за любой совет
На вот, возьми, пользуйся на здоровье и не страдай больше. Да не забывай каждый раз благодарить меня, любимого, за то, что я есть.
Код:
[Выделить все]
(defun put (pt / cc)
  (setq cc (mapcar '(lambda (x y) (atof (rtos x 2 y)))
             (vlax-safearray->list (vlax-variant-value (if (wcmatch (vla-get-ObjectName it) "*Polyline,*Leader")
                                                         (vlax-get-property it pt n) (vlax-get-property it pt)))) prc))
  (if (not (wcmatch (vla-get-ObjectName it) "*Polyline,*Leader"))
    (vlax-put-property it pt (vlax-3d-point cc))
    (vlax-put-property it pt n
      (if (wcmatch (vla-get-ObjectName it) "*DPolyline,*Leader") (vlax-3d-point cc)
        (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 1)) cc)))));if
);end
;
(defun C:CrdRndUp (/ adoc csp mod prc n)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (mapcar '(lambda (x y) (set x (vlax-get-property adoc y))) '(util ms ps)
    '(Utility ModelSpace PaperSpace))
  (vla-startundomark adoc)
  (vla-InitializeUserInput util 128 "Вместе Порознь")
  (setq mod (vla-getKeyword util "Округлять координаты [Вместе/Порознь]: ? <Вместе>")
        prc0 (if (null prc0) 0 prc0))
  (if (= mod "") (setq mod "Вместе"))
  (if (= mod "Вместе")
    (progn (setq prc0 (if (listp prc0) (car prc0) prc0))
      (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
            (setq prc (vla-getInteger util (strcat "Количество знаков после запятой <" (itoa prc0) "> : " ))))))
        (setq prc prc0));if
      (setq prc (list prc prc prc)));progn
    (setq prc0 (if (not (listp prc0)) (list prc0 prc0 prc0) prc0)                 
          prc (mapcar '(lambda (x y / z) (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
                 (setq z (vla-getInteger util (strcat "Количество знаков после запятой для " x " <" (itoa y) "> : " ))))))
                 (setq z y) (setq y z))) '("X" "Y" "Z") prc0)));if
  (setq prc0 prc)
  (foreach sp (list ms ps)
      (vlax-for it sp
        (cond ((wcmatch (vla-get-ObjectName it) "*Circle,*Ellipse,*Arc") (put "Center"))
              ((wcmatch (vla-get-ObjectName it) "*Ttext,*BlockReference") (put "InsertionPoint"))
              ((wcmatch (vla-get-ObjectName it) "*Line") (mapcar '(lambda (x) (put x)) '(StartPoint EndPoint)))              
              ((wcmatch (vla-get-ObjectName it) "*Polyline,*Leader") (setq n 0)
               (while (<= n (1- (vlax-curve-getEndParam it))) (put "Coordinate") (setq n (1+ n))))
              (t nil))
        ));foreach
  (vla-regen adoc acallviewports)
  (vla-endundomark adoc) 
);end
И пжалста, доложь о результатах.
Лентяй вне форума  
 
Непрочитано 23.08.2006, 04:17 Re: Округление координат, полилиний, центров окружностей, бл
#4
SkiFF

ГИПую, Конструирую, считаю, черчу
 
Регистрация: 18.01.2006
В поиске места работы и жительства
Сообщений: 143
<phrase 1= Отправить сообщение для SkiFF с помощью Skype™


Цитата:
Сообщение от Лентяй
И пжалста, доложь о результатах.
Как запустить то
__________________
Строишь завод, проводишь реактора испытание?
грохнется иль долбанет - дважды проверь заранее!
SkiFF вне форума  
 
Непрочитано 23.08.2006, 04:23 Re: Округление координат, полилиний, центров окружностей, бл
#5
SkiFF

ГИПую, Конструирую, считаю, черчу
 
Регистрация: 18.01.2006
В поиске места работы и жительства
Сообщений: 143
<phrase 1= Отправить сообщение для SkiFF с помощью Skype™


А допустим вариант для выбраных объектов. При чем с жестким требованием выбора объектов округления, а то можно весь чертеж испортить.
И буду благодарить ......
__________________
Строишь завод, проводишь реактора испытание?
грохнется иль долбанет - дважды проверь заранее!
SkiFF вне форума  
 
Непрочитано 23.08.2006, 07:22 Re: Округление координат, полилиний, центров окружностей, бл
#6
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от SkiFF
Цитата:
Сообщение от Лентяй
И пжалста, доложь о результатах.
Как запустить то
Да как обычно. Копируешь прогу в Notepad, сохраняешь гдн-нить с расширением .lsp, затем appload и печатаешь в коммандной сторке CrdRndUp, жмешь Enter, и будет тебе щястя
Лентяй вне форума  
 
Непрочитано 23.08.2006, 07:24 Re: Округление координат, полилиний, центров окружностей, бл
#7
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от SkiFF
А допустим вариант для выбраных объектов. При чем с жестким требованием выбора объектов округления, а то можно весь чертеж испортить.
И буду благодарить ......
Можно, но DCL ваять не буду. А выбор из командной строки - это пжалста.
Лентяй вне форума  
 
Автор темы   Непрочитано 23.08.2006, 10:38
#8
MA2


 
Регистрация: 22.08.2006
Москва
Сообщений: 9


РЕЗУЛЬТАТЫ/
Странно, но у меня ничего не заработало
1. ПОСЛЕ команды "CRDRNDUP" идет запрос "Округлять координаты [Вместе/Порознь]: ?" затем еще один запрос "Количество знаков после запятой <1> :". на этом обращение с пользователем заканчивается. Дальше появляется вот такие надписи "Command: Regenerating model." и "Command: nil"
Все. Как-то осталось без внимания момент выбора объектов.
И простите мою наглость но можно сразу задать что количество знаков после запетой всегда равно "0", а в место этого лучше вести вопрос до какого целого число округлять. (например округлить до 5 мм, или до 1 метра).
Уважаемый Лентяй, за ту помощь, которую оказываете Вы нам оказываете, Вас не возможно забыть. Внутренняя чистота чертежей будет всегда мне напоминать о Вас.
MA2 вне форума  
 
Автор темы   Непрочитано 23.08.2006, 13:07
#9
MA2


 
Регистрация: 22.08.2006
Москва
Сообщений: 9


Уважаемый Лентяй, приношу Вам свои извинения. Все работает, вершины точек линий переносятся в новое положение, блоки то же, окружности также, Вот только первая вершина полилиний остается на месте и не изменяется. И не сочти те меня нахалом но можно все же сделать выбор объектов, и выбор степени округления?
MA2 вне форума  
 
Непрочитано 23.08.2006, 13:09
#10
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от MA2
РЕЗУЛЬТАТЫ/
Странно, но у меня ничего не заработало
1. ПОСЛЕ команды "CRDRNDUP" идет запрос "Округлять координаты [Вместе/Порознь]: ?" затем еще один запрос "Количество знаков после запятой <1> :". на этом обращение с пользователем заканчивается. Дальше появляется вот такие надписи "Command: Regenerating model." и "Command: nil"
Все. Как-то осталось без внимания момент выбора объектов.
А чего бы вы хотели? "Вместе/Порознь" определяет, округляются ли координаиы по X, Y и Z вместе или по отдельности. :twisted:
А если вам нужен выбор объектов, то держите доработку.
Код:
[Выделить все]
(defun put (pt / cc)
  (setq cc (mapcar '(lambda (x y) (atof (rtos x 2 y)))
             (vlax-safearray->list (vlax-variant-value (if (wcmatch (vla-get-ObjectName it) "*Polyline,*Leader")
                                                         (vlax-get-property it pt n) (vlax-get-property it pt)))) prc))
  (if (not (wcmatch (vla-get-ObjectName it) "*Polyline,*Leader"))
    (vlax-put-property it pt (vlax-3d-point cc))
    (vlax-put-property it pt n
      (if (wcmatch (vla-get-ObjectName it) "*DPolyline,*Leader") (vlax-3d-point cc)
        (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 1)) cc)))));if
);end
;
(defun rnd (ss / it)
  (vlax-for it ss
        (cond ((wcmatch (vla-get-ObjectName it) "*Circle,*Ellipse,*Arc") (put "Center"))
              ((wcmatch (vla-get-ObjectName it) "*Text,*BlockReference") (put "InsertionPoint"))
              ((wcmatch (vla-get-ObjectName it) "*Line") (mapcar '(lambda (x) (put x)) '(StartPoint EndPoint)))              
              ((wcmatch (vla-get-ObjectName it) "*Polyline,*Leader") (setq n 0)
               (while (<= n (1- (vlax-curve-getEndParam it))) (put "Coordinate") (setq n (1+ n))))
              (t nil)))
);rnd
;
(defun C:CrdRndUp (/ adoc ass ms ps mod prc n opt1 opt2)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (mapcar '(lambda (x y) (set x (vlax-get-property adoc y))) '(ass util ms ps)
    '(ActiveSelectionSet Utility ModelSpace PaperSpace))
  (if (> (vla-get-count ass) 0) (vla-clear ass))
  (vla-startundomark adoc)
  (vla-InitializeUserInput util 128 "Вместе Порознь")
  (setq mod (vla-getKeyword util "Округлять координаты [Вместе/Порознь]: <Вместе>?")
        prc0 (if (null prc0) 0 prc0))
  (if (= mod "") (setq mod "Вместе"))
  (if (= mod "Вместе")
    (progn (setq prc0 (if (listp prc0) (car prc0) prc0))
      (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
            (setq prc (vla-getInteger util (strcat "Количество знаков после запятой <" (itoa prc0) "> : " ))))))
        (setq prc prc0));if
      (setq prc (list prc prc prc)));progn
    (setq prc0 (if (not (listp prc0)) (list prc0 prc0 prc0) prc0)                 
          prc (mapcar '(lambda (x y / z) (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
                 (setq z (vla-getInteger util (strcat "Количество знаков после запятой для " x " <" (itoa y) "> : " ))))))
                 (setq z y) (setq y z))) '("X" "Y" "Z") prc0)));if
  (setq prc0 prc)
  (vla-InitializeUserInput util 128 "Все ВЫбрать Тип")
  (setq opt1 (vla-getKeyword util "Выберете объекты: [Все/ВЫбрать]: <Все>"))
  (if (= opt1 "") (setq opt1 "Все"))
  (if (= opt1 "Все") (foreach sp (list ms ps) (rnd sp))
    (progn (vla-InitializeUserInput util 128 "Circle Ellipse Arc Text BlockReference Line Polyline Leader")
      (setq opt2 (vla-getKeyword util "Выбрать объекты по типу или <ENTER> для указания [Circle/Ellipse/Arc/Text/BlockReference/Line/Polyline/Leader]: "))
      (if (= opt2 "") (vla-selectOnScreen ass)
        (vla-select ass acSelectionSetAll nil nil (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
           (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list (strcat "*" opt2)))));if
      (rnd ass)));if
  (vla-regen adoc acallviewports)
  (vla-endundomark adoc) 
);end
Элемент бусурманщины определяется исключительно удобством написания кода. В противном случае пришлось бы перетолмачивать. а мне лениво .
Опять же, проьба доложито результатах, потому как проверять мне было снова лениво :twisted: :twisted:
Цитата:
И простите мою наглость но можно сразу задать что количество знаков после запетой всегда равно "0", а в место этого лучше вести вопрос до какого целого число округлять. (например округлить до 5 мм, или до 1 метра).
Я вам одну страшную тайну открою. Все координаты в АвтоКАДе - безразмерные. Размерность устанавливается при определении стиля размеров. Причем округление размеров может не совпадать с внутренними координатами АвтоКАДа.
Лентяй вне форума  
 
Автор темы   Непрочитано 23.08.2006, 13:19
#11
MA2


 
Регистрация: 22.08.2006
Москва
Сообщений: 9


Да знаю я, что нету в акаде нет размерности координат. Скажу так Нужна степень округления координат, измеряемая в единицах чертежа. Понятно, если чудик из ВК все чертит метрах, то округлять его координаты нужно до 0,005. Если архитектурная часть, где одна единица чертежа равна 1 миллиметру, 5 единиц измерения чертежа, я думаю достаточная точность.
MA2 вне форума  
 
Автор темы   Непрочитано 23.08.2006, 13:26
#12
MA2


 
Регистрация: 22.08.2006
Москва
Сообщений: 9


Результат. Новый код, с выбором объектов, так же прекрасно работает, только вот все же последняя вершина полилинии не меняет свое положение
MA2 вне форума  
 
Непрочитано 23.08.2006, 18:52
#13
SkiFF

ГИПую, Конструирую, считаю, черчу
 
Регистрация: 18.01.2006
В поиске места работы и жительства
Сообщений: 143
<phrase 1= Отправить сообщение для SkiFF с помощью Skype™


А вот бы еще чтобы округлять до 100 или до 1000 или до 10 или до 5 или до 37 и цены вам нет
__________________
Строишь завод, проводишь реактора испытание?
грохнется иль долбанет - дважды проверь заранее!
SkiFF вне форума  
 
Непрочитано 24.08.2006, 00:10
#14
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от MA2
Да знаю я, что нету в акаде нет размерности координат. Скажу так Нужна степень округления координат, измеряемая в единицах чертежа. Понятно, если чудик из ВК все чертит метрах, то округлять его координаты нужно до 0,005. Если архитектурная часть, где одна единица чертежа равна 1 миллиметру, 5 единиц измерения чертежа, я думаю достаточная точность.
Не понял, он что, все в пространстве листа все чертит, что-ли? Насколько я понимаю в медицине, он в этом случае бессильна. Однако, если копировать его ВКаки в пространство модели, есс-но, соот-но масштабируя, то кого волнует, какие единицы этот ВКакер использовал. А стиль размеров можно поменять, и будет всем щастя .
Лентяй вне форума  
 
Автор темы   Непрочитано 24.08.2006, 10:17
#15
MA2


 
Регистрация: 22.08.2006
Москва
Сообщений: 9


ВК чертит так, если есть длина 1 метр, в пространстве модели это 1 единица, а не 1000 как мне хотелось бы. Ладно ВК можно и отмасштабировать. НЕ проблема. Но как сделать так чтоб последняя вершина полилинии то же меняла свое положение, я не знаю Уважаемый Лентяй В коде программы который вы тут представили есть такая ошибка, не могли бы ВЫ это подправить. а то получается что все точки меняют свое положение, а последняя вершина полилинии нет. НЕ порядок И так глобально, возможно ли в лиспе организовать округление? что то вроде ROUND. Ели нужно всю идею переваривать на VBA?
MA2 вне форума  
 
Непрочитано 24.08.2006, 12:11
#16
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Замените строку
Код:
[Выделить все]
(while (<= n (1- (vlax-curve-getEndParam it))) (put "Coordinate") (setq n (1+ n))))
на
Код:
[Выделить все]
 (while (<= (if (= (vla-get-closed it) :vlax-true) (1- n) n)
                          (vlax-curve-getEndParam it)) (put "Coordinate") (setq n (1+ n))))
и будет вам щастя
Лентяй вне форума  
 
Автор темы   Непрочитано 24.08.2006, 13:21
#17
MA2


 
Регистрация: 22.08.2006
Москва
Сообщений: 9


Щастье не случилось теперь если полилиния Closed, появляется такое сообщение "Automation Error. Invalid index", при состоянии полилинии open все работает, последняя точка меняет свое положение.
MA2 вне форума  
 
Непрочитано 24.08.2006, 14:09
#18
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Ну, подумешь. напутал слегка, плюсб минус - делов-то... Попробуй так:
Код:
[Выделить все]
(while (<= (if (= (vla-get-closed it) :vlax-true) (1+ n) n) 
                          (vlax-curve-getEndParam it)) (put "Coordinate") (setq n (1+ n))))
Лентяй вне форума  
 
Автор темы   Непрочитано 24.08.2006, 15:30
#19
MA2


 
Регистрация: 22.08.2006
Москва
Сообщений: 9


Спасибо, действительно очень сильно помогли. Не знаю, что случилось, но первый вариант заработал, а второй выдает ошибку "Automation Error. Description was not provided", но при этом то же работает. Странно. . А по поводу степени округления координат, мне так и не понятно, возможно это реализовать на лиспе, или нет?
MA2 вне форума  
 
Непрочитано 24.08.2006, 22:28
#20
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от MA2
Спасибо, действительно очень сильно помогли. Не знаю, что случилось, но первый вариант заработал, а второй выдает ошибку "Automation Error. Description was not provided", но при этом то же работает. Странно. . А по поводу степени округления координат, мне так и не понятно, возможно это реализовать на лиспе, или нет?
Действительно, непонятка получаестя [sm2100]... У меня все работает, и безо всяких страшеых сообщений. Хотя с моим 2005, как ни странно, проходят всякие грязные трюки, типа присвоения символу знака или функции. МБ, 2006 более чувствителен к подобным насилиям. Впрочем, попробуйте такой более "правильный" варинт:
Код:
[Выделить все]
(while (<= n (- (vlax-curve-getEndParam it)
(if (= (vla-get-closed it) :vlax-true) 1 0)) (put "Coordinate") (setq n (1+ n))))
и, как обычно, плз, доложьте о результатах. Успехов [sm2200]
Что же касается округления до десятокв и сотен, да еще и с учетом с учетом единиц, то это требует отдельной программы.
Лентяй вне форума  
Закрытая тема
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Округление координат, полилиний, центров окружностей, блоков

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

Расширенный поиск