_

Rzutowanie na polilinie

Forum poświęcone flagowemu produktowi oraz aplikacjom pochodnym Autodesku. To jedyne forum mające w tytule nazwę programu, a to ze względu na jego olbrzymią popularność w Polsce. Można tutaj umieszczać również posty z ogólnie pojętej tematyki "Kreślarskie 2D".

Rzutowanie na polilinie

Postprzez marhalec » sty 17, 2018 14:04

Witam!

Potrzebuje pomocy mianowicie mam kilka tysięcy pkt. do zrzutowania na polilinie i ewentualnie stworzenie z tego jakiegoś dokumentu, notatnika z domiarem wszystkich pikiet czy excel. Czy byłaby szansa stworzyć taki lisp?
marhalec
 
Posty: 5
Dołączył(a): sty 17, 2018 13:56

Re: Rzutowanie na polilinie

Postprzez kojacek » sty 17, 2018 14:19

marhalec napisał(a):Witam!

Potrzebuje pomocy mianowicie mam kilka tysięcy pkt. do zrzutowania na polilinie i ewentualnie stworzenie z tego jakiegoś dokumentu, notatnika z domiarem wszystkich pikiet czy excel. Czy byłaby szansa stworzyć taki lisp?


Oczywiście że się da. Daj przykładowy rysunek. Nie wiemy co rozumiesz przez punkty, na jaką polilinię rzutować, itp.
Avatar użytkownika
kojacek
 
Posty: 5430
Dołączył(a): paź 03, 2005 20:17

Re: Rzutowanie na polilinie

Postprzez marhalec » sty 17, 2018 15:13

Witam, mam do zrzutowania kilka tysięcy pikiet w załączniku mały przykład. W dwgu są dwie osie jezdni i w zależności po której stronie są pikiety na tą ośkę muszę zrzutować (hektometr + domiar do niej) Hektometru raczej nie oczekuję że się da wyciągnąc z cada ale domiar prostopadły myślę że jest szansa wyciagnac do excela ( nr pikety + domiar). Czyli załóżmy zaznaczam pikiety które chce wskazuje polilinie zapisuje excela czy notatnik i tyle. Byłaby szansa?
Załączniki
Ośki korekta.dwg
(162.91 KiB) Pobrane 16 razy
Pikiety.txt
(33.3 KiB) Pobrane 23 razy
Ostatnio edytowany przez marhalec, sty 17, 2018 21:38, edytowano w sumie 1 raz
marhalec
 
Posty: 5
Dołączył(a): sty 17, 2018 13:56

Re: Rzutowanie na polilinie

Postprzez ziele_o2k » sty 17, 2018 16:26

Mam narzędzia do takiego czegoś napisane w lispie.
Wszystko da się wyciągnąć, razem z hektometrem.
W wolnej chwili obrobię i podrzucę.

Będzie działać na plikach csv.
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 682
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Rzutowanie na polilinie

Postprzez ziele_o2k » sty 17, 2018 16:47

Jedyne co potrzebuję wiedzieć, to kilometr na początku polilinii, no i polilinie muszą być prawidłowo narysowane (pierwszy wierzchołek to początek kilometrażu).

Patrz obrazek.

Tutaj lisp do odwracania polilinii
Kod: Zaznacz cały
(defun c:revlwpline ( / *error* e footer done vertices header flag)
  ;reverse lightweight polyline (ssname pl 0)

  (if (and (princ "\nPick a LWpolyline:")(setq e (ssname(ssget "_+.:S:E" '((0 . "LWPOLYLINE")))0)))
    (progn
      (foreach item (reverse (entget e))
        (cond
          ((not done)
            (cond
              ((= (car item) 40)
                (setq footer (cons (cons 41 (cdr item)) footer)      ;swap width
                      done t
                )
              )
              ((= (car item) 41)
                (setq footer (cons (cons 40 (cdr item)) footer))     ;swap width
              )
              ((= (car item) 42)
                (setq footer (cons (cons 42 (- (cdr item))) footer)) ;negate bulge
              )
              ((= (car item) 210)
                (setq footer (cons item footer))
              )
            )
          )
          ((= (car item) 10)
            (setq vertices (cons item vertices))
          )
          ((= (car item) 40)
            (setq vertices (cons (cons 41 (cdr item)) vertices))     ;swap width
          )
          ((= (car item) 41)
            (setq vertices (cons (cons 40 (cdr item)) vertices))     ;swap width
          )
          ((= (car item) 42)
            (setq vertices (cons (cons 42 (- (cdr item))) vertices)) ;negate bulge
          )
          (t (setq header (cons item header)))
        )
      )
      (setq flag (assoc 70 header))
      (if (< (cdr flag) 128)                 ;turn on linetype generation
        (setq header (subst (cons 70 (+ (cdr flag) 128)) flag header))
      )
      (entmod (append header (reverse vertices) footer))
    )
    (princ "\nMissed. Try again")
  )
)
Załączniki
2018-01-17_15-42-38.jpg
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 682
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Rzutowanie na polilinie

Postprzez marhalec » sty 17, 2018 21:39

Podmieniłem plik z ośkami jak możesz to zerknij, z góry dziękuje.
marhalec
 
Posty: 5
Dołączył(a): sty 17, 2018 13:56

Re: Rzutowanie na polilinie

Postprzez ziele_o2k » sty 19, 2018 02:19

Pierwszy fragment kodu jest.
Klik
example.gif

i sprawdzamy jak działa.
Jutro reszta i instrukcje.

Kod: Zaznacz cały
(defun c:blkin ( / _fle _dta _att_pos _tmp _x_pos _y_pos _z_pos)
  (if
    (and
      (setq _fle (getfiled "Select CSV File" "" "csv" 16))
      (setq _dta (LM:readcsv _fle))

    )
    (progn
      (setq _att_pos  (vl-position "Att" (setq _tmp (car _dta))))
      (setq _x_pos    (vl-position "x_cad" _tmp))
      (setq _y_pos    (vl-position "y_cad" _tmp))
      (setq _z_pos    (vl-position "z_cad" _tmp))
      (foreach % (cdr _dta)
        (if
          (cd:BLK_InsertBlock
            (list
              (atof (vl-string-translate "," "." (nth _x_pos %)))
              (atof (vl-string-translate "," "." (nth _y_pos %)))
              (if _z_pos
                (atof (vl-string-translate "," "." (nth _z_pos %)))
                0
              )
            )
            "forumcadpl_znacznik"
            nil
            nil
            T
          )
          (cd:BLK_SetAttValueVLA (entlast) "DESC" (nth _att_pos %))
        )
      )
    )
    (princ "\n...::: Coś nie poszło :::...")
  )
  (princ)
)










;; Read CSV  -  Lee Mac
;; Parses a CSV file into a matrix list of cell values.
;; csv - [str] filename of CSV file to read
 
(defun LM:readcsv ( csv / des lst sep str )
  (if (setq des (open csv "r"))
    (progn
      (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
      (while (setq str (read-line des))
        (setq lst (cons (LM:csv->lst str sep 0) lst))
      )
      (close des)
    )
  )
  (reverse lst)
)
 
;; CSV -> List  -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)
 
(defun LM:csv->lst ( str sep pos / s )
  (cond
    ( (not (setq pos (vl-string-search sep str pos)))
      (if (wcmatch str "\"*\"")
        (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2))))
        (list str)
      )
    )
    ( (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
        (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
      )
      (LM:csv->lst str sep (+ pos 2))
    )
    ( (wcmatch s "\"*\"")
      (cons
        (LM:csv-replacequotes (substr str 2 (- pos 2)))
        (LM:csv->lst (substr str (+ pos 2)) sep 0)
      )
    )
    (   (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0)))
  )
)
 
(defun LM:csv-replacequotes ( str / pos )
  (setq pos 0)
  (while (setq pos (vl-string-search  "\"\"" str pos))
    (setq str (vl-string-subst "\"" "\"\"" str pos)
          pos (1+ pos)
    )
  )
  str
)

CadPack wczytany :)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 682
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Rzutowanie na polilinie

Postprzez marhalec » sty 19, 2018 09:03

ziele_o2k napisał(a):Pierwszy fragment kodu jest.
Klik
example.gif

i sprawdzamy jak działa.
Jutro reszta i instrukcje.

Kod: Zaznacz cały
(defun c:blkin ( / _fle _dta _att_pos _tmp _x_pos _y_pos _z_pos)
  (if
    (and
      (setq _fle (getfiled "Select CSV File" "" "csv" 16))
      (setq _dta (LM:readcsv _fle))

    )
    (progn
      (setq _att_pos  (vl-position "Att" (setq _tmp (car _dta))))
      (setq _x_pos    (vl-position "x_cad" _tmp))
      (setq _y_pos    (vl-position "y_cad" _tmp))
      (setq _z_pos    (vl-position "z_cad" _tmp))
      (foreach % (cdr _dta)
        (if
          (cd:BLK_InsertBlock
            (list
              (atof (vl-string-translate "," "." (nth _x_pos %)))
              (atof (vl-string-translate "," "." (nth _y_pos %)))
              (if _z_pos
                (atof (vl-string-translate "," "." (nth _z_pos %)))
                0
              )
            )
            "forumcadpl_znacznik"
            nil
            nil
            T
          )
          (cd:BLK_SetAttValueVLA (entlast) "DESC" (nth _att_pos %))
        )
      )
    )
    (princ "\n...::: Coś nie poszło :::...")
  )
  (princ)
)










;; Read CSV  -  Lee Mac
;; Parses a CSV file into a matrix list of cell values.
;; csv - [str] filename of CSV file to read
 
(defun LM:readcsv ( csv / des lst sep str )
  (if (setq des (open csv "r"))
    (progn
      (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
      (while (setq str (read-line des))
        (setq lst (cons (LM:csv->lst str sep 0) lst))
      )
      (close des)
    )
  )
  (reverse lst)
)
 
;; CSV -> List  -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)
 
(defun LM:csv->lst ( str sep pos / s )
  (cond
    ( (not (setq pos (vl-string-search sep str pos)))
      (if (wcmatch str "\"*\"")
        (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2))))
        (list str)
      )
    )
    ( (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
        (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
      )
      (LM:csv->lst str sep (+ pos 2))
    )
    ( (wcmatch s "\"*\"")
      (cons
        (LM:csv-replacequotes (substr str 2 (- pos 2)))
        (LM:csv->lst (substr str (+ pos 2)) sep 0)
      )
    )
    (   (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0)))
  )
)
 
(defun LM:csv-replacequotes ( str / pos )
  (setq pos 0)
  (while (setq pos (vl-string-search  "\"\"" str pos))
    (setq str (vl-string-subst "\"" "\"\"" str pos)
          pos (1+ pos)
    )
  )
  str
)

CadPack wczytany :)


; błąd: zły typ argumentu: fixnump: nil - ok, z tym poradziłem.

Teraz - ; błąd: no function definition: CD:BLK_INSERTBLOCK
Ostatnio edytowany przez marhalec, sty 19, 2018 11:39, edytowano w sumie 1 raz
marhalec
 
Posty: 5
Dołączył(a): sty 17, 2018 13:56

Re: Rzutowanie na polilinie

Postprzez ziele_o2k » sty 19, 2018 10:25

to było na szybko napisane,
plik csv ma wygladać tak:
csv.jpg
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 682
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Rzutowanie na polilinie

Postprzez ziele_o2k » sty 23, 2018 01:38

To jedziemy,
plik CSV, z którego będziemy importować bloki z oznaczeniami już pokazałem jak ma wyglądać.
Tutaj jeszcze raz funkcje, które nas interesują:
Kod: Zaznacz cały
(defun c:blkin ( / _fle _dta _att_pos _tmp _x_pos _y_pos _z_pos)
  (if
    (and
      (setq _fle (getfiled "Select CSV File" "" "csv" 16))
      (setq _dta (LM:readcsv _fle))

    )
    (progn
      (setq _att_pos  (vl-position "Att" (setq _tmp (car _dta))))
      (setq _x_pos    (vl-position "x_cad" _tmp))
      (setq _y_pos    (vl-position "y_cad" _tmp))
      (setq _z_pos    (vl-position "z_cad" _tmp))
      (foreach % (cdr _dta)
        (if
          (cd:BLK_InsertBlock
            (list
              (atof (vl-string-translate "," "." (nth _x_pos %)))
              (atof (vl-string-translate "," "." (nth _y_pos %)))
              (if _z_pos
                (atof (vl-string-translate "," "." (nth _z_pos %)))
                0
              )
            )
            "forumcadpl_znacznik"
            nil
            nil
            T
          )
          (cd:BLK_SetAttValueVLA (entlast) "DESC" (nth _att_pos %))
        )
      )
    )
    (princ "\n...::: Coś nie poszło :::...")
  )
  (princ)
)


(defun c:blkmea ( / _ss _sta_pnt _ent _fn _tmp _res)
  (princ "\nWskaż punkty do pomiaru: ")
  (if
    (and
      (setq _ss (ssget '((0 . "INSERT") (2 . "forumcadpl_znacznik"))))
      (setq _ent (car (entsel "\nWskaż polilinię: ")))
      (= (cdr (assoc 0 (entget _ent))) "LWPOLYLINE")
      (setq _sta_pnt (getreal "\nPodaj kilometraż punktu początkowego polilinii"))
      (setq _fn (getfiled "Create Output File" "" "csv" 1))
    )
    (foreach % (cd:SSX_Convert _ss 0)
      (setq _tmp
        (list
          (cd:BLK_GetAttValueVLA % "DESC")
          (cd:CON_Real2Str
            (+ _sta_pnt
              (vlax-curve-getDistAtPoint _ent
                (vlax-curve-getClosestPointTo _ent
                  (trans (cdr (assoc 10 (entget %))) % 0)
                )
              )
            )
            2 2
          )
        )
      )
      (setq _res (cons _tmp _res))
    )
  )
  (if _res
    (LM:WriteCSV (reverse _res) _fn)
  )
  (princ)
)

;; Read CSV  -  Lee Mac
;; Parses a CSV file into a matrix list of cell values.
;; csv - [str] filename of CSV file to read
 
(defun LM:readcsv ( csv / des lst sep str )
  (if (setq des (open csv "r"))
    (progn
      (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
      (while (setq str (read-line des))
        (setq lst (cons (LM:csv->lst str sep 0) lst))
      )
      (close des)
    )
  )
  (reverse lst)
)
 
;; CSV -> List  -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)
 
(defun LM:csv->lst ( str sep pos / s )
  (cond
    ( (not (setq pos (vl-string-search sep str pos)))
      (if (wcmatch str "\"*\"")
        (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2))))
        (list str)
      )
    )
    ( (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
        (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
      )
      (LM:csv->lst str sep (+ pos 2))
    )
    ( (wcmatch s "\"*\"")
      (cons
        (LM:csv-replacequotes (substr str 2 (- pos 2)))
        (LM:csv->lst (substr str (+ pos 2)) sep 0)
      )
    )
    (   (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0)))
  )
)
 
(defun LM:csv-replacequotes ( str / pos )
  (setq pos 0)
  (while (setq pos (vl-string-search  "\"\"" str pos))
    (setq str (vl-string-subst "\"" "\"\"" str pos)
          pos (1+ pos)
    )
  )
  str
)

;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil
 
(defun LM:writecsv ( lst csv / des sep )
  (if (setq des (open csv "w"))
    (progn
      (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
      (foreach row lst (write-line (LM:lst->csv row sep) des))
      (close des)
      t
    )
  )
)
 
;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token
 
(defun LM:lst->csv ( lst sep )
  (if (cdr lst)
    (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
    (LM:csv-addquotes (car lst) sep)
  )
)
 
(defun LM:csv-addquotes ( str sep / pos )
  (cond
    ( (wcmatch str (strcat "*[`" sep "\"]*"))
      (setq pos 0)   
      (while (setq pos (vl-string-position 34 str pos))
        (setq str (vl-string-subst "\"\"" "\"" str pos)
          pos (+ pos 2)
        )
      )
      (strcat "\"" str "\"")
    )
    ( str )
  )
)

blkin - do importu
blkmea - do pomiaru odległości od początku polilinii.

W załączeniu blok, który ma być w ścieżce przeszukiwań cada (pamiętamy, że do ścieżek przeszukiwania cada należy też folder z aktualnie otwartym plikiem dwg) lub wystarczy go dodać do bazy rysunku (przez wstaw->blok)

W razie pytań krzyczeć.
Załączniki
forumcadpl_znacznik.dwg
(16.01 KiB) Pobrane 13 razy
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 682
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Następna strona

Powrót do AutoCAD

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników