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

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

Определение высотной отметки по двум соседним отметкам.

Ответ
Поиск в этой теме
Непрочитано 03.10.2008, 09:36 #1
Определение высотной отметки по двум соседним отметкам.
Supermax
 
Руководитель фирмы
 
Москва
Регистрация: 28.03.2007
Сообщений: 1,831

Есть такая проблема: На геоподоснове много высотных отметок, но надо знать приблизительно отметку в данной точке. Рельеф простой, без извилин. между двумя отметками ровная наклонная поверхность. Надо указав точку, ткнуть в текст отметки,считать его, затем ткнуть в другую точку и далее в ее текст, далее ткнуть в ту точку, которой надо определить высотную отметку и получить на этом месте значек отметки с текстом этой отметки.

Может и есть такое у кого-нибудь, я в темах не нашел. Буду признателен за наводку или помощь в создании.
Просмотров: 7733
 
Непрочитано 03.10.2008, 10:15
#2
ALEX.RU


 
Регистрация: 26.11.2007
Сообщений: 220


Geonics
ALEX.RU вне форума  
 
Непрочитано 03.10.2008, 10:46
#3
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,695


"Текст отметки" - енто хто? однострочник? Многострочник? Блок с атрибутом? Атрибут?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 03.10.2008, 11:25
#4
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Всегда бывает либо Text, либо Mtext одна строчка. Если есть запятая - поменять перед подсчетом на точку и проверь на принадлежность к числу. Если несколько отметок в Mtext-e, то дать сообщение о невозможности выполнения макроса.
Всякие там блоки, ну можно в принципе запоминать точку указания и после определения типа объекта лезть в его глубины, но пока не надо. Пока не надо. Потом будет надо.
Мне бы пока простенькие цифры переварить.
Supermax вне форума  
 
Непрочитано 03.10.2008, 13:30
#5
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Цитата:
Сообщение от Supermax Посмотреть сообщение
...Мне бы пока простенькие цифры переварить.
Вот так попробуй, основную процдуру пока не пишем ибо ТЗ на нее ясно не оформленно, офоршишь посмотрим, ну или сам ваяй.
Код:
[Выделить все]
;возращает список цифр содержащихся цифр в строке
(defun digitextract (str / lstdgt digit char i)
(setq i 1 digit "")
(repeat (strlen str)
(setq char (substr str i 1))
(if 	(and (>= char "0") (<= char "9"))
	(setq digit (strcat digit char))
	(if (or (= char ".") (= char ","))
	(setq digit (strcat digit "."))
	(if (= digit ".") (setq digit "") 
	(if (/= digit "") (setq lstdgt (append lstdgt (list (atof digit))) digit ""))
)));end of if*3
(setq i (1+ i))
);end of repeat
(if (and (/= digit ".") (/= digit "")) (setq lstdgt (append lstdgt (list (atof digit)))))
lstdgt
);end of digitextract
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 03.10.2008, 14:17
#6
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Цитата:
Если есть запятая - поменять перед подсчетом на точку и проверь на принадлежность к числу.
Можно так:
Код:
[Выделить все]
(defun test (str)
  (if
    (apply 'and
           (mapcar
             '(lambda (el)
                (wcmatch el "#,\,,.")
              ) ;_ end of lambda
             (mapcar 'chr
                     (vl-string->list str)
             ) ;_ end of mapcar
           ) ;_ end of mapcar
    ) ;_ end of apply
     (atof (vl-string-subst "." "," str))
  ) ;_ end of if
) ;_ end of defun
;;;(test "123,75") -> 123.75
;;;(test "123.75") -> 123.75
;;;(test "123a75") -> nil
CB вне форума  
 
Непрочитано 03.10.2008, 14:17
#7
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Цитата:
Сообщение от Supermax Посмотреть сообщение
Есть такая проблема: На геоподоснове много высотных отметок, но надо знать приблизительно отметку в данной точке. Рельеф простой, без извилин. между двумя отметками ровная наклонная поверхность. Надо указав точку, ткнуть в текст отметки,считать его, затем ткнуть в другую точку и далее в ее текст, далее ткнуть в ту точку, которой надо определить высотную отметку и получить на этом месте значек отметки с текстом этой отметки.

Может и есть такое у кого-нибудь, я в темах не нашел. Буду признателен за наводку или помощь в создании.
Я бы так попробовал, не знаю ничего насчет геодезии -
чисто интуитивно:

Код:
[Выделить все]
(defun C:demo  (/ ang dis1 dis2 dis3 dlev dptxt1 dptxt2 dx elist elist1 elist2 newz
		osm prec pt1 pt2 pt3 pt4 ss1 ss2 str1 txt txt1 txt2 zval1 zval2)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0) ;<== important for the calculator
  (setq	pt1    (getpoint "\nFirst point: ")
	ss1    (ssget "_:S" (list (cons 0 "*TEXT")))
	txt1   (ssname ss1 0)
	elist1 (entget txt1)
	zval1  (atof (setq str1 (cdr (assoc 1 elist1))))
	prec   (- (strlen str1) (1+ (vl-string-search "." str1))) ;<== to store precision	
	dptxt1 (cdr (assoc 10 elist1))
	dx (distance pt1 dptxt1)
	ang (angle pt1 dptxt1)
	pt1    (list (car pt1) (cadr pt1) zval1)
	pt2    (getpoint "\nSecond point: ")
	ss2    (ssget "_:S" (list (cons 0 "*TEXT")))
	txt2   (ssname ss2 0)
	elist2 (entget txt2)
	zval2  (atof (cdr (assoc 1 elist2)))
	pt2    (list (car pt2) (cadr pt2) zval2)
	pt3    (getpoint "\nPick a testing point: ")
	)
  ;; load the geometrical Acad's calculator
  (if (not CAL)
    (arxload "geomcal.arx")
    )

  (setq	dis1 (distance pt1 pt2)
	dis2 (C:CAL "dpl(pt3,pt1,pt2)")
	dis3 (sqrt (abs (- (expt (distance pt1 pt3) 2) (expt dis2 2))))
	pt4  (C:CAL "pld(pt1,pt2,dis3)")
	dis3 (distance pt1 pt4)
	newz (caddr pt4)
	)
  (print newz)
  (print "\n")
  (setq	dlev (- zval2 zval1)
	newz (+ zval1 (/ (* dlev dis3) dis1))
	)
(command "point" pt3);<== uncomment by your suit
  (setq dptxt2 (polar pt3 ang dx))
  (command "copy" txt1 "" dptxt1 dptxt2)
  (setq	txt   (entlast)
	elist (entget txt)
	)
  (entmod
    (subst (cons 1 (rtos newz 2 prec)) (assoc 1 elist) elist))
  (entupd txt)
  (setvar "osmode" osm)
  (princ)
  )
fixo вне форума  
 
Автор темы   Непрочитано 03.10.2008, 17:15
#8
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


fixo, отлично! Огромное спасибо. Правда с Mtext не работает, поскольку там 1-й код навороченный бывает, вот у меня такой и попался.
(1 . "\\Ftxt.shx|b0;168.263") тут она и глючит. Да и отключать привязки не нужно, поскольку у меня мышь 8-ми кнопочная и на ней F3 уже стоит. Легким шевелением пальца я и F3, и F8, и Esc, и Del, и Enter могу нажать.
Второй рукой как правило почесываю.

Вместо точки надо что-то покрупнее ставить, типа Tolerance.

Кстати, а его умеет хоть кто-нибудь программно создавать?
Supermax вне форума  
 
Автор темы   Непрочитано 03.10.2008, 17:17
#9
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


СВ и Дима_ тоже благодарствую! с запятыми война идет при помощи ваших кодов.
Supermax вне форума  
 
Непрочитано 03.10.2008, 17:47
#10
Красин


 
Регистрация: 05.09.2008
Сообщений: 24


Цитата:
Сообщение от Supermax Посмотреть сообщение
с Mtext не работает, поскольку там 1-й код навороченный бывает, вот у меня такой и попался.
(1 . "\\Ftxt.shx|b0;168.263")
есть же фунции по удалению форматирующих знаков, как вот эта, имя автора не знаю:
Код:
[Выделить все]
  (defun TTC_MText_Clear(Mtext / Text Str)
    (setq Text "")
    (while(/= Mtext "")
      (cond
  ((wcmatch
     (strcase
       (setq Str
        (substr Mtext 1 2)))
                     "\\[\\{}`~]")
   (setq Mtext(substr Mtext 3)
         Text(strcat Text Str)
   ); end setq
  ); end condition #1
  ((wcmatch(substr Mtext 1 1) "[{}]")
    (setq Mtext
     (substr Mtext 2))
  ); end condition #2
;;;  (
;;;   (and
;;;   (wcmatch
;;;     (strcase
;;;       (substr Mtext 1 2)) "\\P")
;;;   (/=(substr Mtext 3 1) " ")
;;;    ); end and
;;;         (setq Mtext (substr Mtext 3)
;;;               Text (strcat Text " ")
;;;         ); end setq
;;;   ); end condition #3
  ((wcmatch
     (strcase
       (substr Mtext 1 2)) "\\[LO]")
    (setq Mtext(substr Mtext 3))
  ); end condition #4
  ((wcmatch
     (strcase
       (substr Mtext 1 2)) "\\[ACFHQTW]")
    (setq Mtext
     (substr Mtext
       (+ 2
          (vl-string-search ";" Mtext))))
  ); end condition #5
  ((wcmatch
     (strcase (substr Mtext 1 2)) "\\S")
    (setq Str(substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
          Text(strcat Text (vl-string-translate "#^\\" " " Str))
          Mtext(substr Mtext (+ 4 (strlen Str)))
   ); end setq
   (print Str)
  ); end condition #6
  (T
   (setq Text(strcat Text(substr Mtext 1 1))
         Mtext (substr Mtext 2)
   )
  ); end condition #7
      ); end cond
    ); end while
  Text
); end of TTC_MText_Clear
Цитата:
Сообщение от Supermax Посмотреть сообщение
Второй рукой как правило почесываю
Вот это по-нашему!
Пойду в воскресенье за 8-микнопочной
Красин вне форума  
 
Непрочитано 03.10.2008, 17:47
#11
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Правда с Mtext не работает, поскольку там 1-й код навороченный бывает, вот у меня такой и попался.
(1 . "\\Ftxt.shx|b0;168.263") тут она и глючит.
Примени функцию, снимающую форматирование. Например mip_MTEXT_Unformat
В коде fixo поправь выделенное красным
Код:
[Выделить все]
elist1 (entget txt1)
zval1  (atof (setq str1 (mip_MTEXT_Unformat(cdr (assoc 1 elist1)))))
prec   (- (strlen str1) (1+ (vl-string-search "." str1))) ;<== to store precision
...
elist2 (entget txt2)
zval2  (atof (mip_MTEXT_Unformat(cdr (assoc 1 elist2))))
pt2    (list (car pt2) (cadr pt2) zval2)
...
*** Добавлено
Красин,
Цитата:
имя автора не знаю:
Александр Смирнов, ранее известный как Fantomas и {Smirnoff}. По моему был даже модератором старого форума dwg.ru.
К сожалению по неизвестным причинам покинул этот форум. Сейчас известен как ASMI. (сайт автора). А вот и TTC_MText_Clear
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 04.10.2008 в 12:22.
VVA вне форума  
 
Автор темы   Непрочитано 03.10.2008, 18:07
#12
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


УУУУ! Дело идет.

Мышка самая лучшая - Logitech MX-518 (до нее были 500 и 510). Где-то 1500 р. стоит. (у меня 500 и 510 на другом компе).

Вот код создания Tolerance с отметкой точки:

Код:
[Выделить все]
(defun tolerance_point (data point)
(entmake (append ''((0 . "TOLERANCE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "Номера_элементов")) 
                 '((100 . "AcDbFcf") (3 . "Standard"))
                  (list (cons 10 point)) 
                  (list (cons 1 (strcat "{\\Fgdt;j}%%v" (vl-princ-to-string point) "%%v%%v%%v%%v"))) 
                 '((210 0.0 0.0 1.0) (11 1.0 0.0 0.0)))
)
Аргументом нужно число. можно второй аргумент добавить, это слой и третий - стиль да и много чего можно добавить. Вообще можно сделать функцию создающую этот Tolerance в любом виде.
После создания открываем программно последний созданный элемент и ковыряем 330 пару с целю модификации масштаба и прочего.

Немного исправил data - это данные в виде числа (любого)
point - список из трех координат точки вставки элемента.

Последний раз редактировалось Supermax, 03.10.2008 в 18:18.
Supermax вне форума  
 
Непрочитано 03.10.2008, 18:19
#13
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Цитата:
Сообщение от Supermax Посмотреть сообщение
...Да и отключать привязки не нужно, поскольку у меня мышь 8-ми кнопочная и на ней F3 уже стоит. Легким шевелением пальца я и F3, и F8, и Esc, и Del, и Enter могу нажать.
Второй рукой как правило почесываю
8 кнопок для меня чересчур
У меня всего-то по пять пальцев и то
кривых
Со второй рукой поаакуратней там

~'J'~
fixo вне форума  
 
Автор темы   Непрочитано 03.10.2008, 19:00
#14
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Пальцев и трех вполне достаточно. Мизинцем и безымянным я вообще ничего не делаю.
Вот она, настоящая мышка для автокадчиков.

Миниатюры
Нажмите на изображение для увеличения
Название: Мышка.GIF
Просмотров: 534
Размер:	25.4 Кб
ID:	10679  
Supermax вне форума  
 
Автор темы   Непрочитано 03.10.2008, 21:17
#15
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Вот, лиха беда - начало. Чтобы повернуть Talerance надо угол перевести в DirectionVector. И кто знает как?

Есть опсение, что никто.
Supermax вне форума  
 
Непрочитано 03.10.2008, 21:38
#16
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Спасибо за инфу, к моему огорчению, я всего
лишь надомник-любитель и занимаюсь этим только
из чистой любви к искусству
fixo вне форума  
 
Непрочитано 03.10.2008, 22:20
#17
Donhuan

Проектировщик СС
 
Регистрация: 24.06.2008
Минск
Сообщений: 134
<phrase 1=


Цитата:
Сообщение от Supermax Посмотреть сообщение
Вот, лиха беда - начало. Чтобы повернуть Talerance надо угол перевести в DirectionVector. И кто знает как?

Есть опсение, что никто.
Здесь знают.
http://www.theswamp.org/index.php?PH...ic=14771.0;all
Donhuan вне форума  
 
Непрочитано 03.10.2008, 22:55
#18
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Цитата:
Сообщение от Supermax Посмотреть сообщение
Вот, лиха беда - начало. Чтобы повернуть Talerance надо угол перевести в DirectionVector. И кто знает как?

Есть опсение, что никто.
Естественно, никто такой мелочью не парился
Грубо говоря это направление точки зрения,
можешь поиграть со значениями:

Код:
[Выделить все]
(vla-put-DirectionVector tolerObj (vlax-3d-point 1. 0. 0.))
(vla-put-DirectionVector tolerObj (vlax-3d-point 0.5 0.5 0.))  и тд
~'J'~
fixo вне форума  
 
Автор темы   Непрочитано 03.10.2008, 23:19
#19
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Да, Donhuan, там наверное знают, но вчитываться в английский текст просто ужас. Мне бы функцию с аргументом в виде угла поворота в радианах, чтобы она список координат выдавала. И все.
Ну что бедному еврею надо? - Кусочек хлеба и вагон масла. Вот и все.

Я могу сам сделать такую. Про единичную сферу и координаты точки на ней мне все известно, но я думал у народа уже есть такая функция. Думаю, что мучиться? А выходит есть, но не в России. Да и там я не нашел конкретики. А ведь надо. В очень многих элементах вместо 50-ой пары используется 11-ая с этим кошмаром.
Придется вспоминать геометрию.
Когда мы читаем текст, то берем от туда угол поворота, пересчитываем и при создании Tolerance 11 пару делаем как надо.
При чтении того же текста берем свойство Height и его значение переписываем Tolerance свойству TextHeight.
Supermax вне форума  
 
Автор темы   Непрочитано 04.10.2008, 00:23
#20
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Короче в 11 паре идет первая цифра COS угла в градусах, вторая SIN угла в градусах и третья всегда 0.0, поскольку пооси Y мы ничего не крутим. Радианы в градусы - Ad = Ar * 180 / пи Где Ad — угол в градусах, Ar — угол в радианах. пи=3.1415926535897932384626433832795 ну это я так шутю.
Supermax вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Определение высотной отметки по двум соседним отметкам.

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

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