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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Нахождение расстояния между точками на чертеже

Нахождение расстояния между точками на чертеже

Ответ
Страница 3 из 4 < 12 3 4 >
Перейти к новому Перейти к новому  
Поиск в этой теме
Непрочитано 23.08.2010, 09:03
Нахождение расстояния между точками на чертеже
Макс_Кунгур
 
Регистрация: 10.12.2008
Сообщений: 122
Добрый день! Столкнулся с такой задачей. Есть чертеж с множеством точек (около 100). Нужно при помощи языка LISP найти расстояния от одной точки, которую ты укажешь на чертеже, до всех остальных точек. Результат с расстояниями должен вывестись в текстовый файл или в таблицу Excel.
Как найти расстояние между 2-мя точками, я знаю. А вот как до всех точек, пока не разобрался. Подскажите, пожалуйста, как решить данную задачу.
Просмотров: 18881
 
Непрочитано 26.08.2010, 10:41
#41
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 811

Цитата:
Сообщение от CB Посмотреть сообщение
>Олег (jr.)

Пробуй такой вариант. С красотой в Exel'е не заморачивался...
Код:
[Выделить все] 
(defun dwgru-string-to-list (str delimiter / pos)
  (if (= delimiter (chr 32))
    (setq str (dwgru-string-replace
                str
                (strcat (chr 32) (chr 32))
                delimiter
              ) ;_ end of dwgru-string-replace
    ) ;_ end of setq
  ) ;_ end of if
  (if (setq pos (vl-string-search delimiter str))
    (cons
      (substr str 1 pos)
      (dwgru-string-to-list
        (substr
          str
          (+ (strlen delimiter) pos 1)
        ) ;_ end of substr
        delimiter
      ) ;_ end of ru-string-pl-string-to-list
    ) ;_ end of cons
    (cons str '())
  ) ;_ end of if
) ;_ end of defun

(defun test (/ ent lst filename file)
  (setq ent (ssget "_x" '((0 . "MTEXT"))))
  (if ent
    (progn
      (setq lst
             (mapcar
               '(lambda (el)
                  ((lambda (txt pt)
                     (cons
                       (substr (car txt) 3)
                       (mapcar '+
                               pt
                               (list 0. 0. (read (last txt)))
                       ) ;_ end of mapcar
                     ) ;_ end of cons
                   ) ;_ end of lambda
                    (dwgru-string-to-list (car el) "\\P")
                    (cdr el)
                  )
                ) ;_ end of lambda
               (vl-sort
                 (mapcar
                   '(lambda (x)
                      ((lambda (a)
                         (cons
                           (cdr (assoc 1 a))
                           (cdr (assoc 10 a))
                         ) ;_ end of cons
                       ) ;_ end of lambda
                        (entget x)
                      )
                    ) ;_ end of lambda
                   (vl-remove-if
                     'listp
                     (mapcar 'cadr (ssnamex ent))
                   ) ;_ end of vl-remove-if
                 ) ;_ end of mapcar
                 (function
                   (lambda (a b)
                     (< (car a) (car b))
                   ) ;_ end of lambda
                 ) ;_ end of function
               ) ;_ end of vl-sort
             ) ;_ end of mapcar
      ) ;_ end of setq
      (setq
        filename
         (strcat (getvar "dwgprefix")
                 (vl-filename-base (getvar "dwgname"))
                 ".csv"
         ) ;_ end of strcat
      ) ;_ end of setq
      (setq file (open filename "w"))
      (mapcar
        (function
          (lambda (l)
            (foreach i l
              (write-line
                (strcat (car i) " " (rtos (cadr i) 2 2))
                file
              ) ;_ end of write-line
            ) ;_ end of foreach
          ) ;_ end of lambda
        ) ;_ end of function
        (mapcar
          (function
            (lambda (x)
              ((lambda (txt pt)
                 (mapcar
                   '(lambda (y)
                      (list
                        (strcat "r" txt "-" (car y))
                        (distance pt (cdr y))
                      ) ;_ end of list
                    ) ;_ end of lambda
                   (vl-remove x lst)
                 ) ;_ end of mapcar
               ) ;_ end of lambda
                (car x)
                (cdr x)
              )
            ) ;_ end of lambda
          ) ;_ end of function
          lst
        ) ;_ end of mapcar
      ) ;_ end of mapcar
      (close file)
      (print (strcat "Файл " filename " успешно создан..."))
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
Запуск - (test)
Нету нахрен у меня никакого Civil что есть то и хаваем.
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 27.08.2010, 13:25
#42
Макс_Кунгур


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

Дима_, попробовал твою программу. Вроде бы все правильно делает, но мне нужен именно лисп, чтобы я в дальнейшем разобрался в нем и мог сам добавлять в него что-нибудь или убирать.
CB, попробовал твой лисп, выдает ошибку:
Command: (test)
*Cancel*
bad argument type: numberp: {\\FTIMES
Олег (jr.), потестировал твой лисп. Все хорошо работает, только номера точек ставятся по порядку, начиная с 1. А мне нужно, чтобы номера совпадали с названием точки (1Э06, 2Э06 и т.д). Можно это сделать?
Последний раз редактировалось Макс_Кунгур, 27.08.2010 в 13:39.
Макс_Кунгур вне форума  
 
Непрочитано 27.08.2010, 13:48
#43
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 811

Цитата:
Сообщение от Макс_Кунгур Посмотреть сообщение
Дима_, попробовал твою программу. Вроде бы все правильно делает, но мне нужен именно лисп, чтобы я в дальнейшем разобрался в нем и мог сам добавлять в него что-нибудь или убирать.
CB, попробовал твой лисп, выдает ошибку:
Command: (test)
*Cancel*
bad argument type: numberp: {\\FTIMES
Олег (jr.), потестировал твой лисп. Все хорошо работает, только номера точек ставятся по порядку, начиная с 1. А мне нужно, чтобы номера совпадали с названием точки (1Э06, 2Э06 и т.д). Можно это сделать?
Реально нет времени для теста, один раз только прогнал
Смотри сам
Вложения
Тип файла: lsp mpex.LSP (2.8 Кб, 71 просмотров)
Последний раз редактировалось Олег (jr.), 27.08.2010 в 14:47.
Олег (jr.) вне форума  
 
Непрочитано 27.08.2010, 13:52
#44
Дима_

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

Цитата:
Сообщение от Макс_Кунгур Посмотреть сообщение
Дима_, попробовал твою программу. Вроде бы все правильно делает, но мне нужен именно лисп, чтобы я в дальнейшем разобрался в нем и мог сам добавлять в него что-нибудь или убирать.
Ты не поверишь она на лиспе (хоть и не auto):
Код:
[Выделить все] 
#lang scheme/gui
(define (parsing-string bt (lst '()) (btx #""))
  (if (equal? bt #"")
      (reverse (cons btx lst))
      (if (equal? (subbytes bt 0 1) #"\t")
          (parsing-string (subbytes bt 1)
                          (cons btx lst)
                          #"")
          (parsing-string (subbytes bt 1)
                          lst
                          (bytes-append btx (subbytes bt 0 1))))))
(define (distance pt1 pt2)
  (/ (round (* 100 (sqrt (+ (sqr (- (cadr pt1) (cadr pt2)))
                            (sqr (- (caddr pt1) (caddr pt2)))
                            (sqr (- (cadddr pt1) (cadddr pt2))))))) 100))

(define (bytes-join lst x)
  (if (null? lst)
      #""
      (bytes-append (car lst) x (bytes-join (cdr lst) x))))

(define f (new frame%
               [label "Test kungur"]))
(define-values (sf sb)
  (let ([p (new horizontal-panel%
                [parent f])])
    (values (new text-field%
                 [parent p]
                 [label "Исходный файл"])
            (new button%
                 [parent p]
                 [label "Обзор"]
                 [callback (lambda (a b)
                             (let ([file (get-file)])
                               (when (and file (file-exists? file))
                                 (send sf set-value (path->string file)))))]))))

(define-values (of ob)
  (let ([p (new horizontal-panel%
                [parent f])])
    (values (new text-field%
                 [parent p]
                 [label "Конечный файл"])
            (new button%
                 [parent p]
                 [label "Обзор"]
                 [callback (lambda (a b)
                             (let ([file (get-file)])
                               (when file
                                 (send of set-value (path->string file)))))]))))

(define mes (new message%
                 [parent f]
                 [label "Выбирайте файлы..."]
                 [auto-resize #t]))

(define start (new button%
                   [parent f]
                   [label "Start"]
                   [callback (lambda (a b)
                               (let ([file (send sf get-value)]
                                     [otfile (send of get-value)])
                                 (when (and (not (equal? file ""))
                                            (not (equal? otfile ""))
                                            (file-exists? file))
                                   (if (file-exists? otfile)
                                       (send mes set-label "Файл не может быть перезаписан...")
                                       (let ([data (map (lambda (str)
                                                          (list (last str)
                                                                (string->number (bytes->string/utf-8 (cadr str)))
                                                                (string->number (bytes->string/utf-8 (caddr str)))
                                                                (string->number (bytes->string/utf-8 (cadddr str)))))
                                                        (map parsing-string (cdr (file->bytes-lines file))))])
                                         (send mes set-label "Обработка файла...")
                                         (display-lines-to-file
                                          (apply map (lambda x (bytes-join x #";;"))
                                                 (map (lambda (pt1)
                                                        (filter-not
                                                         void?
                                                         (map (lambda (pt2)
                                                                (when (not (equal? pt1 pt2))
                                                                  (bytes-append (car pt1)
                                                                                #"-"
                                                                                (car pt2)
                                                                                #";"
                                                                                (string->bytes/utf-8 (number->string (distance pt1 pt2))))))
                                                              data)))
                                                      data))
                                          (send of get-value) #:separator "\r\n")
                                         (send mes set-label "Готово"))))))]))
(send f center)
(send f show #t)
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 27.08.2010, 14:06
#45
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 811

Цитата:
Сообщение от Дима_ Посмотреть сообщение
чтобы я в дальнейшем разобрался в нем и мог сам добавлять в него что-нибудь или убирать.
Может ему еще Shema нужно для этого учить, это ты предлагаешь?
Олег (jr.) вне форума  
 
Непрочитано 27.08.2010, 14:46
#46
Дима_

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

Нет. Это личный выбор каждого, тем более что "подправить" иногда и не зная языка получается.
p.s. если б я ее на VB, C# или ассемблере написал - это-ж не значит, что я его изучить предлагаю.
p.p.s если б предполагалось, что человек сам хочет написать - я б код в жизни бы не написал, еслиб только советом помог как сделать, здесь не мало народу (включая меня) которые так сами и программировать на лиспе научились - если время позволяет - в любом случае полезней с автокадом и лисп знать (ну хотя-бы ориентироваться), чем руками чертить.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Последний раз редактировалось Дима_, 27.08.2010 в 14:52.
Дима_ вне форума  
 
Непрочитано 27.08.2010, 16:59
#47
CB

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

Цитата:
Сообщение от Макс_Кунгур Посмотреть сообщение
CB, попробовал твой лисп, выдает ошибку:
Command: (test)
*Cancel*
bad argument type: numberp: {\\FTIMES
Значит тестовый чертеж, который ты выложил не соответствует реальному, т.к. {\\FTIMES явно относится к Mtext.
В тестовом примере такого нет.
Набери (entget (car (entsel))), ткни в Mtext и покажи что получилось...
Интересует первая группа.
У меня выдает следующий результат (с учетом z-координаты)
r1Э04-2Э04 47.35
r1Э04-4Э04 36.41
r1Э04-5Э04 55.73
r2Э04-1Э04 47.35
r2Э04-4Э04 56.79
r2Э04-5Э04 36.53
r4Э04-1Э04 36.41
r4Э04-2Э04 56.79
r4Э04-5Э04 47.34
r5Э04-1Э04 55.73
r5Э04-2Э04 36.53
r5Э04-4Э04 47.34
CB вне форума  
 
Непрочитано 27.08.2010, 17:48
#48
Дима_

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

То СВ у тебя нет проверки м-текста (в рисунке могут не только с точками быть но и любые другие - на них по ходу и спотыкается) - самый простой вариант - в ssget "_x" убери - пусть рамкой нужные выбирает (хорошо - еще лисп вылетел а не в данные врет).
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 30.08.2010, 11:51
#49
CB

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

>Дима_
Цитата:
(в рисунке могут не только с точками быть но и любые другие - на них по ходу и спотыкается)
Абсолютно согласен - что если в чертеже будет Mtext не имеющий отношение к точкам, то вылет программы гарантирован. Здесь же дело в другом - форматирование Mtext. Пример (см. первую группу) :
Код:
[Выделить все] 
Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 400725a0>) (0 . "MTEXT") (330 . <Entity 
name: 40070cf8>) (5 . "224") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"0") (100 . "AcDbMText") (10 484304.0 6.3737e+006 0.0) (40 . 2.0) (41 . 0.0) 
(71 . 4) (72 . 5) (1 . "№ 1Э04\\P\\P144.9") (7 . "Standard") (210 0.0 0.0 1.0) 
(11 1.0 0.0 0.0) (42 . 10.0) (43 . 8.66667) (50 . 0.0) (73 . 1) (44 . 1.0))

Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 400725a0>) (0 . "MTEXT") (330 . <Entity 
name: 40070cf8>) (5 . "224") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"0") (100 . "AcDbMText") (10 484304.0 6.3737e+006 0.0) (40 . 2.0) (41 . 0.0) 
(71 . 4) (72 . 5) (1 . "{\\fTxt|b0|i0|c204|p2;\\U+2116 
1Э04\\P\\P\\fArial|b0|i0|c0|p34;144.9}") (7 . "Standard") (210 0.0 0.0 1.0) (11 
1.0 0.0 0.0) (42 . 9.88339) (43 . 8.7754) (50 . 0.0) (73 . 1) (44 . 1.0))
Т.к. в чертеже нет объектов типа POINT, а есть
Код:
[Выделить все] 
Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 400945a8>) (0 . "ACAD_PROXY_ENTITY") (330 . 
<Entity name: 40091cf8>) (5 . "225") (100 . "AcDbEntity") (67 . 0) (410 . 
"Model") (8 . "PTS_UP"))
до точки вставки которого лично мне не удалось добраться, программа ищет Mtext, с точкой вставки объекта (0 . "ACAD_PROXY_ENTITY").

>Макс_Кунгур
Пробуй такой вариант:
Код:
[Выделить все] 
(defun dwgru-string-replace
       (string old_substr new_substr / pos)
  (while (setq pos (vl-string-search old_substr string))
    (setq string
           (strcat
             (substr string 1 pos)
             new_substr
             (dwgru-string-replace
               (substr string (+ (strlen old_substr) pos 1))
               old_substr
               new_substr
             ) ;_ end of ru-string-replace
           ) ;_ end of strcat
    ) ;_ end of setq
  ) ;_ end of while
  string
) ;_ end of defun

;;;----------------------------------------------------
(defun dwgru-string-to-list (str delimiter / pos)
  (if (= delimiter (chr 32))
    (setq str (dwgru-string-replace
                str
                (strcat (chr 32) (chr 32))
                delimiter
              ) ;_ end of dwgru-string-replace
    ) ;_ end of setq
  ) ;_ end of if
  (if (setq pos (vl-string-search delimiter str))
    (cons
      (substr str 1 pos)
      (dwgru-string-to-list
        (substr
          str
          (+ (strlen delimiter) pos 1)
        ) ;_ end of substr
        delimiter
      ) ;_ end of ru-string-pl-string-to-list
    ) ;_ end of cons
    (cons str '())
  ) ;_ end of if
) ;_ end of defun

;;;-------------------------------------------------------------------------
(defun mip_MTEXT_Unformat ( Mtext / text Str )
  ;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=20992
  (setq Text "")
  (if (wcmatch (strcase Mtext) "\\PI-#*,\\PT*") ;;_список
    (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
	   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 8)) "\\FSYMBOL") ;;;Add VVA remove Symbol
            (setq Mtext (substr Mtext (+ 2 (cond ((vl-string-search "}" Mtext))((vl-string-search ";" Mtext)))))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
	  ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PX[QI],\\PTZ")  ;;;Add by KPblC
	   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
	   )
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or
		   (zerop (strlen Text))
		   (= " " (substr Text (strlen Text)))
		   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
	  ((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)))))
          
	  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
  Text)
;;;------------------------------------------------------------------------------------
(defun test (/ ent lst filename file)
  (setq ent (ssget "_x" '((0 . "MTEXT"))))
  (if ent
    (progn
      (setq lst
             (mapcar
               '(lambda (el)
                  ((lambda (txt pt)
                     (cons
                       (cadr txt)
                       (mapcar '+
                               pt
                               (list 0. 0. (read (last txt)))
                       ) ;_ end of mapcar
                     ) ;_ end of cons
                   ) ;_ end of lambda
                    (dwgru-string-to-list (mip_MTEXT_Unformat (car el)) " ")
                    (cdr el)
                  )
                ) ;_ end of lambda
               (vl-sort
                 (mapcar
                   '(lambda (x)
                      ((lambda (a)
                         (cons
                           (cdr (assoc 1 a))
                           (cdr (assoc 10 a))
                         ) ;_ end of cons
                       ) ;_ end of lambda
                        (entget x)
                      )
                    ) ;_ end of lambda
                   (vl-remove-if
                     'listp
                     (mapcar 'cadr (ssnamex ent))
                   ) ;_ end of vl-remove-if
                 ) ;_ end of mapcar
                 (function
                   (lambda (a b)
                     (< (car a) (car b))
                   ) ;_ end of lambda
                 ) ;_ end of function
               ) ;_ end of vl-sort
             ) ;_ end of mapcar
      ) ;_ end of setq
      (setq
        filename
         (strcat (getvar "dwgprefix")
                 (vl-filename-base (getvar "dwgname"))
                 ".csv"
         ) ;_ end of strcat
      ) ;_ end of setq
      (setq file (open filename "w"))
      (mapcar
        (function
          (lambda (l)
            (foreach i l
              (write-line
                (strcat (car i) " " (rtos (cadr i) 2 2))
                file
              ) ;_ end of write-line
            ) ;_ end of foreach
          ) ;_ end of lambda
        ) ;_ end of function
        (mapcar
          (function
            (lambda (x)
              ((lambda (txt pt)
                 (mapcar
                   '(lambda (y)
                      (list
                        (strcat "r" txt "-" (car y))
                        (distance pt (cdr y))
                      ) ;_ end of list
                    ) ;_ end of lambda
                   (vl-remove x lst)
                 ) ;_ end of mapcar
               ) ;_ end of lambda
                (car x)
                (cdr x)
              )
            ) ;_ end of lambda
          ) ;_ end of function
          lst
        ) ;_ end of mapcar
      ) ;_ end of mapcar
      (close file)
      (print (strcat "Файл " filename " успешно создан..."))
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

;;;запуск  -  (test)
CB вне форума  
 
Непрочитано 30.08.2010, 13:24
#50
Дима_

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

Цитата:
Сообщение от CB Посмотреть сообщение
Т.к. в чертеже нет объектов типа POINT, а есть
по этому я и говорю, что не нужно вобще здесь использовать сгененированный автокадом рисунок, искать в нем тексты и пр, получаеться много лишней работы - работать надо всегда с первоисточником данных (в нашем случае - текстовой файл), что у меня и сделанно, но уж коли это необходимо именно под автокад (хотя мне лично не понятно зачем он тут), можно переправить лисп под него, только мне уже честно лень этой программой заниматься, да и автора походу все (Олега лисп по крайней мере) устраивает.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 31.08.2010, 12:08
#51
Макс_Кунгур


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

CB, потестировал твой лисп, выдает в csv файле:
Код:
[Выделить все] 
r141.2-140.0	31.мар
r141.2-147.5	28.сен
r141.2-142.0	29.16
r141.2-156.5	35.59
r141.2-145.9	31.13
r141.2-132.1	21.52
r141.2-10Э06	57.32
r141.2-11Э06	61.78
r141.2-12Э06	68.4
r141.2-13Э06	77.13
r141.2-14Э06	100.07
r141.2-15Э06	71.66
r141.2-1Э04	397.2
r141.2-2Э04	441.56
r141.2-34	107.41
r141.2-35	дек.27
r141.2-4Э04	391.8
r141.2-5Э04	436.89
r140.0-141.2	31.мар
r140.0-147.5	23.35
r140.0-142.0	дек.71
r140.0-156.5	17.27
r140.0-145.9	33.15
r140.0-132.1	17.47
r140.0-10Э06	28.17
r140.0-11Э06	65.36
r140.0-12Э06	55.11
r140.0-13Э06	73.01
r140.0-14Э06	84.14
r140.0-15Э06	49.29
r140.0-1Э04	398.48
r140.0-2Э04	443.38
r140.0-34	104.8
r140.0-35	22.86
r140.0-4Э04	395.77
r140.0-5Э04	440.95
r147.5-141.2	28.сен
r147.5-140.0	23.35
r147.5-142.0	ноя.29
r147.5-156.5	20.37
r147.5-145.9	окт.77
r147.5-132.1	31.69
r147.5-10Э06	45.45
r147.5-11Э06	45.09
r147.5-12Э06	41.46
r147.5-13Э06	54.05
r147.5-14Э06	72.35
r147.5-15Э06	44.82
r147.5-1Э04	417.16
r147.5-2Э04	462.09
r147.5-34	86.2
r147.5-35	17.июн
r147.5-4Э04	413.54
r147.5-5Э04	458.48
r142.0-141.2	29.16
r142.0-140.0	дек.71
r142.0-147.5	ноя.29
r142.0-156.5	16.77
r142.0-145.9	20.88
r142.0-132.1	23.97
r142.0-10Э06	36.62
r142.0-11Э06	53.07
r142.0-12Э06	44.97
r142.0-13Э06	61.05
r142.0-14Э06	75.33
r142.0-15Э06	43.41
r142.0-1Э04	409.89
r142.0-2Э04	454.77
r142.0-34	93.03
r142.0-35	17.июн
r142.0-4Э04	406.73
r142.0-5Э04	451.86
r156.5-141.2	35.59
r156.5-140.0	17.27
r156.5-147.5	20.37
r156.5-142.0	16.77
r156.5-145.9	30.81
r156.5-132.1	31.июл
r156.5-10Э06	28.82
r156.5-11Э06	64.39
r156.5-12Э06	52.76
r156.5-13Э06	69.87
r156.5-14Э06	80.35
r156.5-15Э06	48.07
r156.5-1Э04	403.71
r156.5-2Э04	449.11
r156.5-34	102.28
r156.5-35	26.86
r156.5-4Э04	401.42
r156.5-5Э04	446.02
r145.9-141.2	31.13
r145.9-140.0	33.15
r145.9-147.5	окт.77
r145.9-142.0	20.88
r145.9-156.5	30.81
r145.9-132.1	38.52
r145.9-10Э06	56
r145.9-11Э06	35.5
r145.9-12Э06	39.23
r145.9-13Э06	47.03
r145.9-14Э06	70.44
r145.9-15Э06	47.77
r145.9-1Э04	425.02
r145.9-2Э04	469.78
r145.9-34	78.51
r145.9-35	20.75
r145.9-4Э04	420.74
r145.9-5Э04	465.72
r132.1-141.2	21.52
r132.1-140.0	17.47
r132.1-147.5	31.69
r132.1-142.0	23.97
r132.1-156.5	31.июл
r132.1-145.9	38.52
r132.1-10Э06	42.09
r132.1-11Э06	69.86
r132.1-12Э06	67.13
r132.1-13Э06	81.75
r132.1-14Э06	97.68
r132.1-15Э06	64.21
r132.1-1Э04	389.7
r132.1-2Э04	434.11
r132.1-34	112.68
r132.1-35	20.фев
r132.1-4Э04	385.69
r132.1-5Э04	431.14
r10Э06-141.2	57.32
r10Э06-140.0	28.17
r10Э06-147.5	45.45
r10Э06-142.0	36.62
r10Э06-156.5	28.82
r10Э06-145.9	56
r10Э06-132.1	42.09
r10Э06-11Э06	85.91
r10Э06-12Э06	65.08
r10Э06-13Э06	87.56
r10Э06-14Э06	87.12
r10Э06-15Э06	50.46
r10Э06-1Э04	392.58
r10Э06-2Э04	438.07
r10Э06-34	118.66
r10Э06-35	49.95
r10Э06-4Э04	392.42
r10Э06-5Э04	437.12
r11Э06-141.2	61.78
r11Э06-140.0	65.36
r11Э06-147.5	45.09
r11Э06-142.0	53.07
r11Э06-156.5	64.39
r11Э06-145.9	35.5
r11Э06-132.1	69.86
r11Э06-10Э06	85.91
r11Э06-12Э06	35
r11Э06-13Э06	21.82
r11Э06-14Э06	57.96
r11Э06-15Э06	55.22
r11Э06-1Э04	458.33
r11Э06-2Э04	502.65
r11Э06-34	46.36
r11Э06-35	53.67
r11Э06-4Э04	453.19
r11Э06-5Э04	498.46
r12Э06-141.2	68.4
r12Э06-140.0	55.11
r12Э06-147.5	41.46
r12Э06-142.0	44.97
r12Э06-156.5	52.76
r12Э06-145.9	39.23
r12Э06-132.1	67.13
r12Э06-10Э06	65.08
r12Э06-11Э06	35
r12Э06-13Э06	25
r12Э06-14Э06	31.85
r12Э06-15Э06	21.84
r12Э06-1Э04	453.25
r12Э06-2Э04	498.2
r12Э06-34	53.79
r12Э06-35	56.55
r12Э06-4Э04	450.85
r12Э06-5Э04	496.03
r13Э06-141.2	77.13
r13Э06-140.0	73.01
r13Э06-147.5	54.05
r13Э06-142.0	61.05
r13Э06-156.5	69.87
r13Э06-145.9	47.03
r13Э06-132.1	81.75
r13Э06-10Э06	87.56
r13Э06-11Э06	21.82
r13Э06-12Э06	25
r13Э06-14Э06	37.82
r13Э06-15Э06	46.65
r13Э06-1Э04	470.73
r13Э06-2Э04	515.48
r13Э06-34	32.44
r13Э06-35	67.02
r13Э06-4Э04	466.95
r13Э06-5Э04	512.11
r14Э06-141.2	100.07
r14Э06-140.0	84.14
r14Э06-147.5	72.35
r14Э06-142.0	75.33
r14Э06-156.5	80.35
r14Э06-145.9	70.44
r14Э06-132.1	97.68
r14Э06-10Э06	87.12
r14Э06-11Э06	57.96
r14Э06-12Э06	31.85
r14Э06-13Э06	37.82
r14Э06-15Э06	37.7
r14Э06-1Э04	479.26
r14Э06-2Э04	524.47
r14Э06-34	47.91
r14Э06-35	88.11
r14Э06-4Э04	478.21
r14Э06-5Э04	523.24
r15Э06-141.2	71.66
r15Э06-140.0	49.29
r15Э06-147.5	44.82
r15Э06-142.0	43.41
r15Э06-156.5	48.07
r15Э06-145.9	47.77
r15Э06-132.1	64.21
r15Э06-10Э06	50.46
r15Э06-11Э06	55.22
r15Э06-12Э06	21.84
r15Э06-13Э06	46.65
r15Э06-14Э06	37.7
r15Э06-1Э04	441.8
r15Э06-2Э04	486.91
r15Э06-34	73.03
r15Э06-35	59.46
r15Э06-4Э04	440.87
r15Э06-5Э04	485.99
r1Э04-141.2	397.2
r1Э04-140.0	398.48
r1Э04-147.5	417.16
r1Э04-142.0	409.89
r1Э04-156.5	403.71
r1Э04-145.9	425.02
r1Э04-132.1	389.7
r1Э04-10Э06	392.58
r1Э04-11Э06	458.33
r1Э04-12Э06	453.25
r1Э04-13Э06	470.73
r1Э04-14Э06	479.26
r1Э04-15Э06	441.8
r1Э04-2Э04	47.35
r1Э04-34	502.29
r1Э04-35	405.03
r1Э04-4Э04	36.41
r1Э04-5Э04	55.73
r2Э04-141.2	441.56
r2Э04-140.0	443.38
r2Э04-147.5	462.09
r2Э04-142.0	454.77
r2Э04-156.5	449.11
r2Э04-145.9	469.78
r2Э04-132.1	434.11
r2Э04-10Э06	438.07
r2Э04-11Э06	502.65
r2Э04-12Э06	498.2
r2Э04-13Э06	515.48
r2Э04-14Э06	524.47
r2Э04-15Э06	486.91
r2Э04-1Э04	47.35
r2Э04-34	546.79
r2Э04-35	449.6
r2Э04-4Э04	56.79
r2Э04-5Э04	36.53
r34-141.2	107.41
r34-140.0	104.8
r34-147.5	86.2
r34-142.0	93.03
r34-156.5	102.28
r34-145.9	78.51
r34-132.1	112.68
r34-10Э06	118.66
r34-11Э06	46.36
r34-12Э06	53.79
r34-13Э06	32.44
r34-14Э06	47.91
r34-15Э06	73.03
r34-1Э04	502.29
r34-2Э04	546.79
r34-35	98.11
r34-4Э04	498.07
r34-5Э04	543.41
r35-141.2	дек.27
r35-140.0	22.86
r35-147.5	17.июн
r35-142.0	17.июн
r35-156.5	26.86
r35-145.9	20.75
r35-132.1	20.фев
r35-10Э06	49.95
r35-11Э06	53.67
r35-12Э06	56.55
r35-13Э06	67.02
r35-14Э06	88.11
r35-15Э06	59.46
r35-1Э04	405.03
r35-2Э04	449.6
r35-34	98.11
r35-4Э04	400.43
r35-5Э04	445.54
r4Э04-141.2	391.8
r4Э04-140.0	395.77
r4Э04-147.5	413.54
r4Э04-142.0	406.73
r4Э04-156.5	401.42
r4Э04-145.9	420.74
r4Э04-132.1	385.69
r4Э04-10Э06	392.42
r4Э04-11Э06	453.19
r4Э04-12Э06	450.85
r4Э04-13Э06	466.95
r4Э04-14Э06	478.21
r4Э04-15Э06	440.87
r4Э04-1Э04	36.41
r4Э04-2Э04	56.79
r4Э04-34	498.07
r4Э04-35	400.43
r4Э04-5Э04	47.34
r5Э04-141.2	436.89
r5Э04-140.0	440.95
r5Э04-147.5	458.48
r5Э04-142.0	451.86
r5Э04-156.5	446.02
r5Э04-145.9	465.72
r5Э04-132.1	431.14
r5Э04-10Э06	437.12
r5Э04-11Э06	498.46
r5Э04-12Э06	496.03
r5Э04-13Э06	512.11
r5Э04-14Э06	523.24
r5Э04-15Э06	485.99
r5Э04-1Э04	55.73
r5Э04-2Э04	36.53
r5Э04-34	543.41
r5Э04-35	445.54
r5Э04-4Э04	47.34
Тут, как я понимаю, нужно что-то лишнее убрать.

Олег (jr.), твой последний вариант подходит,то, что нужно, только у тебя в результирующем файле расстояния начинаютя от наибольшего названия точки, а не от наименьшего расстояния и до самого большого. Можно это переделать?
Последний раз редактировалось Кулик Алексей aka kpblc, 31.08.2010 в 14:18.
Макс_Кунгур вне форума  
 
Непрочитано 31.08.2010, 14:18
#52
Кулик Алексей aka kpblc
Moderator

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

Может, просто надо формат ячеек сменить?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 01.09.2010, 12:33
#53
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 811

Цитата:
Сообщение от Макс_Кунгур Посмотреть сообщение
Олег (jr.), твой последний вариант подходит,то, что нужно, только у тебя в результирующем файле расстояния начинаютя от наибольшего названия точки, а не от наименьшего расстояния и до самого большого. Можно это переделать?
Так пойдет?

~'J'~
Вложения
Тип файла: lsp mpex.LSP (3.1 Кб, 64 просмотров)
Последний раз редактировалось Олег (jr.), 02.09.2010 в 09:40.
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 02.09.2010, 10:50
#54
Макс_Кунгур


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

Олег (jr.), у тебя сейчас данные стоят с наименьшего НОМЕРА по наибольший. А мне надо с наименьшего РАССТОЯНИЯ по наибольшее. Т.е., у тебя сейчас выходит:

Point: 1Э04
2Э04 45.2358
4Э04 35.007
5Э04 55.5601
7Э06 397.179
9гЭ06 389.487
......................

А надо:

Point: 1Э04
4Э04 35.007
2Э04 45.2358
5Э04 55.5601
9гЭ06 389.487
7Э06 397.179
......................
Макс_Кунгур вне форума  
 
Непрочитано 02.09.2010, 12:50
#55
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 811

Цитата:
Сообщение от Макс_Кунгур Посмотреть сообщение
Олег (jr.), у тебя сейчас данные стоят с наименьшего НОМЕРА по наибольший. А мне надо с наименьшего РАССТОЯНИЯ по наибольшее. Т.е., у тебя сейчас выходит:

Point: 1Э04
2Э04 45.2358
4Э04 35.007
5Э04 55.5601
7Э06 397.179
9гЭ06 389.487
......................

А надо:

Point: 1Э04
4Э04 35.007
2Э04 45.2358
5Э04 55.5601
9гЭ06 389.487
7Э06 397.179
......................
Понял
Вложения
Тип файла: lsp mpex.LSP (3.1 Кб, 55 просмотров)
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 02.09.2010, 13:08
#56
Макс_Кунгур


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

Олег (jr.), проверил твое последнее творение. То что нужно, огромное спасибо! Скажи, у тебя в подсчете координата z присутствует или нет? Потому что, мне обязательно нужно, чтобы она присутствовала!!!

CB, выкладываю файл, на котором тестировал твой лисп.
Вложения
Тип файла: dwg
DWG 2007		 Distan.dwg (81.1 Кб, 1191 просмотров)
Последний раз редактировалось Макс_Кунгур, 02.09.2010 в 13:19.
Макс_Кунгур вне форума  
 
Непрочитано 02.09.2010, 17:10
#57
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 811

Цитата:
Сообщение от Макс_Кунгур Посмотреть сообщение
Олег (jr.), проверил твое последнее творение. То что нужно, огромное спасибо! Скажи, у тебя в подсчете координата z присутствует или нет? Потому что, мне обязательно нужно, чтобы она присутствовала!!!

CB, выкладываю файл, на котором тестировал твой лисп.
Для определения расстояний используется стандартная функция distance
она учитывает Z координату если точка 3d, так что все пучком

~'J'~
Олег (jr.) вне форума  
 
Непрочитано 02.09.2010, 17:40
#58
CB

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

>Макс_Кунгур
Цитата:
CB, выкладываю файл, на котором тестировал твой лисп.
Врешь ты все...
Где в этом файле
r141.2-140.0 31.мар
r141.2-147.5 28.сен
и т.д.
Да и выше у тебя получалась ошибка {\\FTIMES
Значит какому-то Mtext'у присвоен текстовый стиль TIMES...
Да и вообще, наверняка в файле присутствует Мтекст, не имеющий отношения к точкам, а его нужно отфильтровать в ssget'е...
Во всяком случае проверяй слегка обновленный вариант, тестируемый на том чертеже, что ты выложил (функции dwgru-string-replace, dwgru-string-to-list, mip_MTEXT_Unformat - без изменений):
Код:
[Выделить все] 
(defun test (/ ent lst filename file)
  (setq ent (ssget "_x" '((0 . "MTEXT"))))
  (if ent
    (progn
      (setq lst
             (mapcar
               '(lambda (el)
                  (cons
                    (caar el)
                    (mapcar '+
                            (cdr el)
                            (list 0. 0. (read (cadar el)))
                    ) ;_ end of mapcar
                  ) ;_ end of cons
                ) ;_ end of lambda
               (vl-sort
                 (mapcar
                   '(lambda (x)
                      ((lambda (a)
                         (cons
                           ((lambda (b)
                              (if (> (length b) 2)
                                (cdr b)
                                b
                              ) ;_ end of if
                            ) ;_ end of lambda
                             (dwgru-string-to-list
                               (mip_MTEXT_Unformat
                                 (cdr (assoc 1 a))
                               ) ;_ end of mip_MTEXT_Unformat
                               " "
                             ) ;_ end of dwgru-string-to-list
                           )
                           (cdr (assoc 10 a))
                         ) ;_ end of cons
                       ) ;_ end of lambda
                        (entget x)
                      )
                    ) ;_ end of lambda
                   (vl-remove-if
                     'listp
                     (mapcar 'cadr (ssnamex ent))
                   ) ;_ end of vl-remove-if
                 ) ;_ end of mapcar
                 (function
                   (lambda (a b)
                     (< (caar a) (caar b))
                   ) ;_ end of lambda
                 ) ;_ end of function
               ) ;_ end of vl-sort
             ) ;_ end of mapcar
      ) ;_ end of setq
      (setq
        filename
         (strcat (getvar "dwgprefix")
                 (vl-filename-base (getvar "dwgname"))
                 ".csv"
         ) ;_ end of strcat
      ) ;_ end of setq
      (setq file (open filename "w"))
      (mapcar
        (function
          (lambda (l)
            (write-line
              (strcat "     ТОЧКА " (car l))
              file
            ) ;_ end of write-line
            (foreach i (cadr l)
              (write-line
                (strcat (car i)
                        "    "
                        (rtos (cadr i) 2 2)
                ) ;_ end of strcat
                file
              ) ;_ end of write-line
            ) ;_ end of foreach
          ) ;_ end of lambda
        ) ;_ end of function
        (mapcar
          (function
            (lambda (x)
              ((lambda (txt pt)
                 (list
                   txt
                   (vl-sort
                     (mapcar
                       '(lambda (y)
                          (list
                            (strcat txt " -> " (car y))
                            (distance pt (cdr y))
                          ) ;_ end of list
                        ) ;_ end of lambda
                       (vl-remove x lst)
                     ) ;_ end of mapcar
                     (function
                       (lambda (a b)
                         (< (cadr a) (cadr b))
                       ) ;_ end of lambda
                     ) ;_ end of function
                   ) ;_ end of vl-sort
                 ) ;_ end of list
               ) ;_ end of lambda
                (car x)
                (cdr x)
              )
            ) ;_ end of lambda
          ) ;_ end of function
          lst
        ) ;_ end of mapcar
      ) ;_ end of mapcar
      (close file)
      (print (strcat "Файл " filename " успешно создан..."))
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
CB вне форума  
 
Непрочитано 02.09.2010, 18:15
#59
Дима_

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

Цитата:
Сообщение от Олег (jr.) Посмотреть сообщение
Для определения расстояний используется стандартная функция distance
она учитывает Z координату если точка 3d, так что все пучком
~'J'~
по крайней мере в приложенном примере точки были двухмерными а координата z должна была "тягаться" из текста (собственно почему я и начал говорить - что здесь проще вобще рисунком не пользоваться, а использовать исходный текстовой файл) - посему результат у тебя без учета z - неверный.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 02.09.2010, 18:41
#60
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 811

Цитата:
Сообщение от Дима_ Посмотреть сообщение
- посему результат у тебя без учета z - неверный.
Жжешь,
Кароч, мне твое мнение по барабану
Юзер без тебя разберется
Олег (jr.) вне форума  
Ответ
Страница 3 из 4 < 12 3 4 >
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Нахождение расстояния между точками на чертеже



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Расстояния между компенсаторами тепловых сетей proekt_mep Отопление 10 29.05.2012 14:17
Определение высот рельефа по близлежащим точкам dextron3 Программирование 21 10.11.2011 13:14
Расстояние между проемами в соседних пожарных отсеках (блокированные жилые дома) Koliabek Пожарная безопасность 11 13.05.2009 11:17
Расстояние между видами на чертеже Сеченов Разное 14 09.02.2009 15:50
Как определить расстояние между 2 точками по spline? Хотабыч Программирование 5 22.01.2006 15:33

Обратная связь - Вверх