Построение горизонталей из txt.файла (№точ. X Y H) (Страница 1 из 3)

> Дмитрий
Ответ на этот вопрос лучше искать в разделе Land Desktop

Если у кого есть полная версия topographic скиньте пожалуйста на мыло

лазил по интернету и нашел новый ресурс (не ради рекламы, ради людей) не реклама, вдруг кто найдет то что ему надо:
http://www.cad.dp.ua/program.php

А поподробнее мона?

чертить горизонтали в акаде сразу нельзя надо сначало скинуть в тхт формате в кредо там построить горизонтали потом закинуть в акад опперация займет 15 минут

> Дмитрий
Посмотри здесь: http://www.burshtein.org/ - программка для неограниченного количества точек, строит горизонтали в виде полилиний. Строит TIN поверхность из файла точек или прямо из объектов AutoCad-a. Help внутри "зипа".

Я использую для таких целей 3EZYSURF, прога строит точки из файла, чертит горизонтали и профиля. Могу залить куда-то.

> Mih@nik
[rus] i mne, i mne
[/rus]

> Дмитрий
Можете прислать файл координат из которого строите поверхность?
Спасибо. mihael_b@walla.com

По поводу topographic могу немного помочь

Вот то чего я в принципе и хотел:
Большое спасибо за разработку Oleg_у
Два Lisp приложения
Вычерчивание точек из текстового файла вида: № точки Y X Z
с простановкой точки в координате и подписью номера точки вверху с права
и отметки (координаты Z) внизу справа
При этом создаются три слоя:
Отметки
Точки
Номера точек
Пример:
0 -74.81 56.87 179.92
1 -74.66 55.61 180.10
2 -75.62 56.26 179.72
3 -77.22 53.95 179.59
4 -76.32 53.22 180.10
5 -67.37 45.55 179.55
6 -47.43 29.26 179.73
в комндной строке набрать: TOPY
______________________________________
(defun keyvalue (key lst)
    (cdr (assoc key lst))
  );ok
(defun readfile (fn del / fd st tmp lst)
  (if (setq fd (open fn "r"))
    (while (setq st (read-line fd))
        (setq tmp (strlist st del))
        (setq lst (cons tmp lst))
      )
)
  (if fd (close fd))
  (reverse lst)
);ok
(defun strlist (strExp strDel / strLst)
  (while (setq pos (vl-string-position (ascii strDel) strExp))
    (setq itm (substr strExp 1 pos))
    (setq strLst (append strLst (list itm)))
    (setq strExp (substr strExp (+ pos 2)))
  )
  (setq strLst (append strLst (list strExp)))
);ok
(defun check-layer (name color)
    (or
      (tblsearch "layer" name)
      (entmake
        (list
          '(0 . "LAYER")
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbLayerTableRecord")
          '(70 . 0)
          (cons 2 name)
          (cons 62 color)))))
(defun entmakestyle (name ht wid obl font)
(or (tblsearch "STYLE" name)
(entmake
(list
'(0 . "STYLE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbTextStyleTableRecord")
(cons 2 name)
'(70 . 0); флаг стиля
(cons 40 ht); высота текста
(cons 41 wid); коэф-т ширины букв
(cons 50 obl); наклон
'(71 . 0); флаг отображения текста
;;;'(42 . 0.2); высота последнего используемого стиля
(cons 3  font); имя файла шрифта c расширением
;;;'(4 . ""); big font
)
)
  )
  )
;;;(entmakestyle "TEXT-STYLE" 250.0 0.8 0.0 "simplex.shx")жщл
;;  minimum to entmake lwpolyline - by Michael Puckett
;;            :arguments: a point list flag for close and pline width
(defun entmakelwpline (plist flag layer width)
(entmake
(append
(list
(cons 0  "LWPOLYLINE")
(cons 100  "AcDbEntity")
(cons 8  layer)
(cons 100  "AcDbPolyline")
(cons 90 (length plist)) ;number of verticies
(cons 70 flag)
(cons 43 width) ;constant width
)
(mapcar '(lambda (x) (cons 10 x)) plist)
)
)
)
(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
    (repeat num (setq ls
            (cons (car lst) ls)
          lst (cdr lst)))
    (setq ret (append ret (list (reverse ls)))
          ls nil)))
    )
ret
  )
;get polyline vertices
(defun get-vexs (pline_obj / verts)
      (setq verts (vlax-get pline_obj 'Coordinates)
        verts
          (cond
            ((wcmatch (vlax-get pline_obj 'Objectname )
                 "AcDb2dPolyline,AcDb3dPolyline")
             (group-by-num verts 3)
            )
            ((eq (vlax-get pline_obj 'Objectname )
                 "AcDbPolyline")
             (group-by-num verts 2)
            )
            (T nil)
          )
)
  )
(defun C:topy (/    acsp     cpt      elev       elist    en         fname
        hgt     int_point       int_points         lp
        maxitm     maxp      minitm   minp        num         p1
        p2     p3      p4       p5        pl
        plane_points      pt       pts        pu         rad
        rp     segm_points       spl        tmp         topodata
           )
  (setvar "cmdecho" 0)
(check-layer "Отметки" 253)
(check-layer "Точки" 137)
(check-layer "Номера точек" 117)
(setq fname (getfiled "* Выбрать файл для считывания координат *" (getvar "dwgprefix") "txt" 8))
(setq topodata (readfile fname (chr 32)))
(setq topodata (mapcar (function (lambda(x)
        (list (car x)
              (atof (cadr x))
              (atof (caddr x))
              (atof (last x)))))
               topodata))
(setq rad 0.25)
(repeat (length topodata)
  (setq tmp (car topodata))
  (setq num (car tmp)
    pt (trans (list (caddr tmp)(cadr tmp) (last tmp)) 0 1)
    pts (cons (list (car pt)(cadr pt)) pts)
    hgt (rtos (last tmp) 2 2))
  (setq pu (trans (list (+ rad (car pt))(+ (* rad 2)(cadr pt))(caddr pt)) 0 1)
    pl (trans (list (+ rad (car pt))(- (cadr pt)(* rad 2))(caddr pt)) 0 1)
    )
(entmake
        (list
        (cons 0  "TEXT")
        (cons 100  "AcDbEntity")
        (cons 100  "AcDbText")
        (cons 1 num)
        (cons 7 "Standard")
        (cons 8 "Номера точек")
    (cons 62 256)
        (cons 10 pu)
        (cons 11 pu)
        (cons 40 1.0)
    (cons 41 1.0)
    (cons 50 0.0)
    (cons 51 0.0)
    '(71 . 0)
    '(72 . 0)
    '(73 . 0)
    )
    )
(entmake
        (list
        (cons 0  "TEXT")
        (cons 100  "AcDbEntity")
        (cons 100  "AcDbText")
        (cons 1 hgt)
        (cons 7 "Standard")
        (cons 8 "Отметки")
    (cons 62 256)
        (cons 10 pl)
        (cons 11 pl)
        (cons 40 1.0)
    (cons 41 1.0)
    (cons 50 0.0)
    (cons 51 0.0)
    '(71 . 0)
    '(72 . 0)
    '(73 . 3)
    )
    )
(entmake
(list
(cons 0 "CIRCLE")
(cons 100 "AcDbEntity")
(cons 67  0)
(cons 410  "Model")
(cons 8  "Точки")
(cons 6  "Continuous")
(cons 100  "AcDbCircle")
(cons 10 pt)
(cons 40 rad)))
(setq en (entlast)
      elist (entget en)
      cpt (keyvalue 10 elist)
      rad (keyvalue 40 elist)
      lp (trans (list (- (car cpt) rad)(cadr cpt)(caddr cpt)) 0 1)
      rp (trans (list (+ (car cpt) rad)(cadr cpt)(caddr cpt)) 0 1)
      )
(setvar "hpassoc" 0)
(entmake
(list
(cons 0  "HATCH")
(cons 100  "AcDbEntity")
(cons 67  0)
(cons 410  "Model")
(cons 8  "Точки")
(cons 100  "AcDbHatch")
(cons 10 (list 0.0 0.0 0.0))
(cons 210 (list 0.0 0.0 1.0))
(cons 2  "SOLID")
(cons 70  1)
(cons 71  0)
(cons 91  1)
(cons 92  7)
(cons 72  1)
(cons 73  1)
(cons 93  2)
(cons 10 rp);right
;;;(10 100.784 120.344 0.0)
(cons 42  1.0)
(cons 10 lp);right
;;;(10 101.284 120.344 0.0)
(cons 42  1.0)
(cons 97  0)
(cons 75  0)
(cons 76  1)
(cons 47  0.01)
;;;(47 . 0.00423485)
(cons 98  1)
(cons 10 cpt)
;;;(10 101.086 120.531 0.0)
(cons 450  0)
(cons 451  0)
(cons 460  0.0)
(cons 461  0.0)
(cons 452  1)
(cons 462  1.0)
(cons 453  2)
(cons 463  0.0)
(cons 63  5)
(cons 421  255)
(cons 463  1.0)
(cons 63  7)
(cons 421  16777215)
(cons 470  "LINEAR")))
(setq topodata (cdr topodata))
)
  (command "_.zoom" "_a")
(setvar "cmdecho" 1)
  (princ)
  )
; TesT : (C:topy)
(princ "\n  *  В командной строке набрать TOPY (англ.)  *")
(princ)
______________________________________________________________
Вычерчивание точек из текстового файла вида: № точки X Y Z
с простановкой точки в координате и подписью номера точки вверху с права
и отметки (координаты Z) внизу справа
При этом создаются три слоя:
Отметки
Точки
Номера точек
Пример:
0 -74.81 56.87 179.92
1 -74.66 55.61 180.10
2 -75.62 56.26 179.72
3 -77.22 53.95 179.59
4 -76.32 53.22 180.10
5 -67.37 45.55 179.55
6 -47.43 29.26 179.73
в комндной строке набрать: TOPX
______________________________________
(defun keyvalue (key lst)
    (cdr (assoc key lst))
  );ok
(defun readfile (fn del / fd st tmp lst)
  (if (setq fd (open fn "r"))
    (while (setq st (read-line fd))
        (setq tmp (strlist st del))
        (setq lst (cons tmp lst))
      )
)
  (if fd (close fd))
  (reverse lst)
);ok
(defun strlist (strExp strDel / strLst)
  (while (setq pos (vl-string-position (ascii strDel) strExp))
    (setq itm (substr strExp 1 pos))
    (setq strLst (append strLst (list itm)))
    (setq strExp (substr strExp (+ pos 2)))
  )
  (setq strLst (append strLst (list strExp)))
);ok
(defun check-layer (name color)
    (or
      (tblsearch "layer" name)
      (entmake
        (list
          '(0 . "LAYER")
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbLayerTableRecord")
          '(70 . 0)
          (cons 2 name)
          (cons 62 color)))))
(defun entmakestyle (name ht wid obl font)
(or (tblsearch "STYLE" name)
(entmake
(list
'(0 . "STYLE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbTextStyleTableRecord")
(cons 2 name)
'(70 . 0); флаг стиля
(cons 40 ht); высота текста
(cons 41 wid); коэф-т ширины букв
(cons 50 obl); наклон
'(71 . 0); флаг отображения текста
;;;'(42 . 0.2); высота последнего используемого стиля
(cons 3  font); имя файла шрифта c расширением
;;;'(4 . ""); big font
)
)
  )
  )
;;  minimum to entmake lwpolyline - by Michael Puckett
;;            :arguments: a point list flag for close and pline width
(defun entmakelwpline (plist flag layer width)
(entmake
(append
(list
(cons 0  "LWPOLYLINE")
(cons 100  "AcDbEntity")
(cons 8  layer)
(cons 100  "AcDbPolyline")
(cons 90 (length plist)) ;number of verticies
(cons 70 flag)
(cons 43 width) ;constant width
)
(mapcar '(lambda (x) (cons 10 x)) plist)
)
)
)
(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
    (repeat num (setq ls
            (cons (car lst) ls)
          lst (cdr lst)))
    (setq ret (append ret (list (reverse ls)))
          ls nil)))
    )
ret
  )
;get polyline vertices
(defun get-vexs (pline_obj / verts)
      (setq verts (vlax-get pline_obj 'Coordinates)
        verts
          (cond
            ((wcmatch (vlax-get pline_obj 'Objectname )
                 "AcDb2dPolyline,AcDb3dPolyline")
             (group-by-num verts 3)
            )
            ((eq (vlax-get pline_obj 'Objectname)
                 "AcDbPolyline")
             (group-by-num verts 2)
            )
            (T nil)
          )
)
  )
(defun C:topx (/    acsp     cpt      elev       elist    en         fname
        hgt     int_point       int_points         lp
        maxitm     maxp      minitm   minp        num         p1
        p2     p3      p4       p5        pl
        plane_points      pt       pts        pu         rad
        rp     segm_points       spl        tmp         topodata
           )
(setvar "cmdecho" 0)
(check-layer "Отметки" 253)
(check-layer "Точки" 137)
(check-layer "Номера точек" 117)
(setq fname (getfiled "* Выбрать файл для считывания координат *" (getvar "dwgprefix") "txt" 8))
(setq topodata (readfile fname (chr 32)))
(setq topodata (mapcar (function (lambda(x)
        (list (car x)
              (atof (cadr x))
              (atof (caddr x))
              (atof (last x)))))
               topodata))
(setq rad 0.25)
(repeat (length topodata)
  (setq tmp (car topodata))
  (setq num (car tmp)
    pt (trans (list (cadr tmp)(caddr tmp) (last tmp)) 0 1)
    pts (cons (list (car pt)(cadr pt)) pts)
    hgt (rtos (last tmp) 2 2))
  (setq pu (trans (list (+ rad (car pt))(+ (* rad 2)(cadr pt))(caddr pt)) 0 1)
    pl (trans (list (+ rad (car pt))(- (cadr pt)(* rad 2))(caddr pt)) 0 1)
    )
(entmake
        (list
        (cons 0  "TEXT")
        (cons 100  "AcDbEntity")
        (cons 100  "AcDbText")
        (cons 1 num)
        (cons 7 "Standard")
        (cons 8 "Номера точек")
    (cons 62 256)
        (cons 10 pu)
        (cons 11 pu)
        (cons 40 1.0)
    (cons 41 1.0)
    (cons 50 0.0)
    (cons 51 0.0)
    '(71 . 0)
    '(72 . 0)
    '(73 . 0)
    )
    )
(entmake
        (list
        (cons 0  "TEXT")
        (cons 100  "AcDbEntity")
        (cons 100  "AcDbText")
        (cons 1 hgt)
        (cons 7 "Standard")
        (cons 8 "Отметки")
    (cons 62 256)
        (cons 10 pl)
        (cons 11 pl)
        (cons 40 1.0)
    (cons 41 1.0)
    (cons 50 0.0)
    (cons 51 0.0)
    '(71 . 0)
    '(72 . 0)
    '(73 . 3)
    )
    )
(entmake
(list
(cons 0 "CIRCLE")
(cons 100 "AcDbEntity")
(cons 67  0)
(cons 410  "Model")
(cons 8  "Точки")
(cons 6  "Continuous")
(cons 100  "AcDbCircle")
(cons 10 pt)
(cons 40 rad)))
(setq en (entlast)
      elist (entget en)
      cpt (keyvalue 10 elist)
      rad (keyvalue 40 elist)
      lp (trans (list (- (car cpt) rad)(cadr cpt)(caddr cpt)) 0 1)
      rp (trans (list (+ (car cpt) rad)(cadr cpt)(caddr cpt)) 0 1)
      )
(setvar "hpassoc" 0)
(entmake
(list
(cons 0  "HATCH")
(cons 100  "AcDbEntity")
(cons 67  0)
(cons 410  "Model")
(cons 8  "Точки")
(cons 100  "AcDbHatch")
(cons 10 (list 0.0 0.0 0.0))
(cons 210 (list 0.0 0.0 1.0))
(cons 2  "SOLID")
(cons 70  1)
(cons 71  0)
(cons 91  1)
(cons 92  7)
(cons 72  1)
(cons 73  1)
(cons 93  2)
(cons 10 rp);right
;;;(10 100.784 120.344 0.0)
(cons 42  1.0)
(cons 10 lp);right
;;;(10 101.284 120.344 0.0)
(cons 42  1.0)
(cons 97  0)
(cons 75  0)
(cons 76  1)
(cons 47  0.01)
;;;(47 . 0.00423485)
(cons 98  1)
(cons 10 cpt)
;;;(10 101.086 120.531 0.0)
(cons 450  0)
(cons 451  0)
(cons 460  0.0)
(cons 461  0.0)
(cons 452  1)
(cons 462  1.0)
(cons 453  2)
(cons 463  0.0)
(cons 63  5)
(cons 421  255)
(cons 463  1.0)
(cons 63  7)
(cons 421  16777215)
(cons 470  "LINEAR")))
(setq topodata (cdr topodata))
)
(setvar "cmdecho" 1)
(command "_.zoom" "_a")
  (princ)
  )
; TesT : (C:topx)
(princ "\n  *  В командной строке набрать TOPX (англ.)  *")
(princ)