Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Отрасль → Геодезия и картография → Пересчет высоты
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Есть блок с атрибутами:
NN – номер пикета
H - высота
NAME - имя
POINT – станция
Стоит задача изменить значение Н для всех блоков в файле на определенную величину.
По идее это не сложно, но к сожалению я далек от программирования.
Всем заранее благодарен!
А в какой программе работаете?
Autodesk Map 2004 (2000)
Незнаю как в мапе, но в ленде высоты пересчитываются функцией датум
Никогда не работал с лендом. Но думаю что не покатит. Блок PIKET создается с помощью довески к акаду ТОРОМАП (Киев), при закачке файла из тахеометра.
Обычно снимаю в условной системе (Х=1000м, У=1000м, Н=100м) и сажаю в исх. координаты с помощью операции 3Daling (3Dвыравнивание), а с пересчетом высот проблемка. Есть проги, а точнее конвертаторы которые могут пересчитать высоту в исходном файле (*.SDR-сокия, *.М5 – тримбл или *.ТХТ), но это занимает много времени.
попробуйте вот это
;Dobavlyaet k vtoromu atributu chislo.
(defun c:at+ ( / numplus sset maxnumb blcrun attrun spsatt
att txtrun lenrun endtxt begtxt txtcut
txtnum txtplu txtstr attNew myblNew )
(setq numplus (getreal "Enter number to summ:"))
(setq sset (ssget "_:L" '(( 0 . "INSERT") (66 . 1))))
(setq maxnumb (sslength sset))
(setq i -1)
(repeat maxnumb
(setq i (+ 1 i))
(setq blcrun (ssname sset i))
(setq at1run (entnext blcrun)) ; imya atributa 1
(setq attrun (entnext at1run)) ; imya atributa 2
(setq spsatt (entget attrun)) ; spisok atributa
(setq att (assoc 1 spsatt))
(setq txtrun (cdr (assoc 1 (entget attrun))))
(setq txtnum (atof txtrun))
(setq txtplu (+ txtnum numplus))
(setq txtstr (rtos txtplu 2 2))
(setq attNew (cons 1 txtstr))
(setq myblNew (subst attNew att spsatt))
(entmod myblNew)
(entupd (cdr (assoc -1 myblNew)))
); konec repeat
);konec defun
Спасибо Victor. Прога работает, но не совсем так как хотелось бы. При выделении пикета курсором идет пересчет высоты только в этом пикете, а нужно во всех. Например в проекте 5000 объектов на разных слоях, 1000 из них пикеты. Выбирать отдельно все пикеты или выключать все ненужные слоя очень долго. Если можно переделайте код для пересчета всех пикетов одновременно.
Вариант только изменения атрибута "H":
(defun c:at+ (/ _kpblc-conv-vla-to-list *error* adoc selset attr plus)
(defun _kpblc-conv-vla-to-list (value / res)
;|
* Преобразовывает vlax-variant или vlax-safearray в список.
|;
(cond
((listp value)
(mapcar '_kpblc-conv-vla-to-list value)
)
((= (type value) 'variant)
(_kpblc-conv-vla-to-list (vlax-variant-value value))
)
((= (type value) 'safearray)
(if (>= (vlax-safearray-get-u-bound value 1) 0)
(_kpblc-conv-vla-to-list (vlax-safearray->list value))
) ;_ end of if
)
(t value)
) ;_ end of cond
) ;_ end of defun
(defun loc:getattr (ent tag)
(vl-remove-if-not
'(lambda (x) (wcmatch (strcase (vla-get-tagstring x)) (strcase tag)))
(apply 'append
(mapcar
'_kpblc-conv-vla-to-list
(list (vla-getattributes ent) (vla-getconstantattributes ent))
) ;_ end of mapcar
) ;_ end of apply
) ;_ end of vl-remove-if-not
) ;_ end of defun
(defun *error* (msg)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(if
(and
(setq selset (ssget '((0 . "INSERT") (2 . "PIKET") (66 . 1))))
(member
(type (setq
plus (vl-catch-all-apply
'(lambda () (getdist "\nДобавляемая высота <Отмена> : "))
) ;_ end of vl-catch-all-apply
) ;_ end of setq
) ;_ end of type
(list 'int 'real)
) ;_ end of member
) ;_ end of and
(foreach ent (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
) ;_ end of mapcar
(if (setq attr (loc:getattr ent "h"))
(vl-catch-all-apply
'(lambda ()
(foreach item attr
(vla-put-textstring
item
(rtos (+ (atof (vla-get-textstring item)) plus))
) ;_ end of vla-put-textstring
) ;_ end of foreach
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(vla-regen adoc acactiveviewport)
(vla-endundomark adoc)
(princ)
) ;_ end of defunВАША прога Алексей решает проблему пересчета высот у всех пикетов, и тут же создает новую – проставляя после точки четыре знака (100.0000), а надо в любом случае только два (100.00). И как-то неудобно выделять полностью объект (чертеж), чтобы прога нашла пикеты для обработки. Хочется указать один блок (piket), прога должна определить количество блоков с именем piket в файле и изменить у всех значение атрибута Н на определенную величину. При этом знаков после точки должно быть только два (114.22).
А такой вариант?
(defun c:at2+ (/ _kpblc-conv-vla-to-list *error* adoc selset attr plus)
(defun _kpblc-conv-vla-to-list (value / res)
;|
* Преобразовывает vlax-variant или vlax-safearray в список.
|;
(cond
((listp value)
(mapcar '_kpblc-conv-vla-to-list value)
)
((= (type value) 'variant)
(_kpblc-conv-vla-to-list (vlax-variant-value value))
)
((= (type value) 'safearray)
(if (>= (vlax-safearray-get-u-bound value 1) 0)
(_kpblc-conv-vla-to-list (vlax-safearray->list value))
) ;_ end of if
)
(t value)
) ;_ end of cond
) ;_ end of defun
(defun loc:getattr (ent tag)
(vl-remove-if-not
'(lambda (x) (wcmatch (strcase (vla-get-tagstring x)) (strcase tag)))
(apply 'append
(mapcar
'_kpblc-conv-vla-to-list
(list (vla-getattributes ent) (vla-getconstantattributes ent))
) ;_ end of mapcar
) ;_ end of apply
) ;_ end of vl-remove-if-not
) ;_ end of defun
(defun *error* (msg)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(if
(and
(setq selset (ssget "_X" '((0 . "INSERT") (2 . "PIKET") (66 . 1))))
(member
(type (setq
plus (vl-catch-all-apply
'(lambda () (getdist "\nДобавляемая высота <Отмена> : "))
) ;_ end of vl-catch-all-apply
) ;_ end of setq
) ;_ end of type
(list 'int 'real)
) ;_ end of member
) ;_ end of and
(foreach ent (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
) ;_ end of mapcar
(if (setq attr (loc:getattr ent "h"))
(vl-catch-all-apply
'(lambda ()
(foreach item attr
(vla-put-textstring
item
(rtos (+ (atof (vla-get-textstring item)) plus) 2 2)
) ;_ end of vla-put-textstring
) ;_ end of foreach
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(vla-regen adoc acactiveviewport)
(vla-endundomark adoc)
(princ)
) ;_ end of defunМожно, конечно, более универсальный вариант сделать...
P.S. Если блок будет лежать в составе другого блока или находиться на заблокированном / замороженном слое, он (блок) будет исключен из обработки
> shuba
Есть команда которая оставляет нужный слой
layiso
То что надо! Браво маэстро!
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Отрасль → Геодезия и картография → Пересчет высоты
Форум работает на PunBB, при поддержке Informer Technologies, Inc
