Ajutor export puncte

[phibrizzo]

Buna ziua. Vin la dumneavoastra cu urmatoarea problema : se dau mai multe polilinii inchise ce au in fiecare vertex puncte raportate cu topolt. Ce as vrea eu : sa export in fisier csv punctele de contur in format "nr.pct,x,y,z " selectand polilinia ce le uneste. Cel mai aproape de adevar am ajuns cu lispul urmator(luat tot de pe site probabil) doar ca imi da doar "nr.pct,x,y" si face un tabel in autocad :

Cod [Selectează] Extinde

(defun C:tabpol(/ ss e1 e l1 l2 vlist i l2)
;sx a blokkok halmaza amik a polilyne-on vannak
 (setq ss (car (entsel "\nPolylinia:")))
 (setq ss2 (ssget "x" (list (cons 0 "INSERT"))))
 (setq ename ss)
 (setq e1 ss)
 (setq e (entget e1))
 (setq lay (cdr (assoc 8 e)))
 (setq pon (cdr (assoc 70 e)))
 (setq l1 nil)
 (setq l2 nil)
 (setq vlist nil)
 (if (or (= (cdr (assoc 0 e)) "LWPOLYLINE") (= (cdr (assoc 0 e)) "POLYLINE"))
  (progn
   (if (= (cdr (assoc 0 e)) "POLYLINE")
     (progn
       (setq e1 (entnext e1))
       (setq e (entget e1))
       (setq l1 nil)
       (while (/= (cdr (assoc 0 e)) "SEQEND")
         (setq l1 (append (list (cdr (assoc 10 e))) l1))
;          (print (cdr (assoc 10 e)))
         (setq z (cdr (assoc 10 e)))
         (setq e1 (entnext e1))
         (setq e (entget e1))
       )
       (setq l2 (reverse l1))
       (setq i (1- (length l1)))
     ) ;end progn
     (progn
       (setq vlist (entget e1))
       (setq i 0)
       (while (< i (cdr (assoc 90 vlist)))
         (setq l1 (append (list (getLwVert i)) l1))
;          (print (getLwVert i))
         (setq i (1+ i))
       )
       (setq l2 (reverse l1))
       (setq i (1- (length l1)))
     ) ;end progn
   ) ;end if
   (setq ptx (getpoint "\nPunct de inceput tabel:"))
;    (command "text" "J" "R" ptx "" "" "Puncte")
   (command "text" ptx "" "" "==============================")
   (command "text" "" "| Numar|Coordonata|Coordonata|")
   (command "text" "" "| punct|     X    |     Y    |")
   (command "text" "" "|------+----------+----------|")
   (setq i 0)
   (setq sx (ssadd))
   (while (< i (length l1))
     (setq pt (nth i l1))
;(print i)
;a j valtozo vegigpasztazza a Blockkokat hogy melyik block van
;beszurva a csomopontra
     (setq j 0)
     (while (< j (sslength ss2))
       (if (equal (cdr (assoc 10 (entget (ssname ss2 j)))) pt 0.1)
         (progn
           (setq ee1 (entnext (ssname ss2 j)))
           (setq nrs (cdr (assoc 1 (entget ee1))))
           (setq nrs (strx nrs 6))

           (setq pt (cdr (assoc 10 (entget (ssname ss2 j)))))
           (setq x (car pt))
           (setq xs (rtos x 2 2))
           (setq xs (strx xs 10))

           (setq y (cadr pt))
           (setq ys (rtos y 2 2))
           (setq ys (strx ys 10))

           (command "text" "" (strcat "|" nrs "|" ys "|" xs "|"))
           (setq sx (ssadd (ssname ss2 j) sx))
         )
       )
       (setq j (1+ j))
     ) ;end while j
     (setq i (1+ i))
   ) ;end while i
   (command "text" "" "|------+----------+----------|")
   (command "area" "e" ename)
   (setq a (getvar "area"))
   (setq a1 (rtos a 2 2))
   (setq a2 (strcat "S = " a1 " mp"))
   (setq a2 (strx a2 18))
   (command "text" "" (strcat "|     " a2 "     |"))
   (command "text" "" "==============================")

;    (setq sx (ssadd ename sx))
   
;    (command "erase" ename "")
  ) ;end progn
 
  (print "Nu este polilinie")
 ) ;end if
)


(defun getLwVert (tmpctr / count tmp)
   (setq count 0)
   (while (/= (car (nth count vlist)) 10)
       (setq count (+ count 1))
   )
   ;; If the counter reaches the number of vertices,
   ;; reset ctr and tmpctr to zero again.
   (if (= tmpctr (cdr (assoc 90 vlist)))
       (progn
       (setq ctr 0)
       (setq tmpctr 0)
       )
   )
   (setq tmp (nth (+ count (* tmpctr 4)) vlist))
   (setq tmp (append tmp (list (cdr (assoc 38 vlist)))))
   (setq pt1 (trans (cdr tmp) (cdr (assoc -1 vlist)) 1))
;    (setq tmp (cons 10 pt1))
   (setq tmp pt1)
;    (setq tmp tmp)
)

(defun plmodi(lay pon)
      (setq e1 (entlast))
      (setq e_listx (entget e1))
      (setq e_listx
         (subst (cons 8 lay) (assoc 8 e_listx) e_listx)
      )
      (entmod e_listx)
      (entupd e1)
      (setq e_listx (entget e1))
      (setq e_listx
         (subst (cons 70 pon) (assoc 70 e_listx) e_listx)
      )
      (entmod e_listx)
      (entupd e1)
)

(defun strx( nrs nk)
 (setq k1 (strlen nrs))
 (setq k1 (- nk k1))
 (setq k 0)
 (setq sk "")
 (while (< k k1)
   (setq sk (strcat " " sk))
   (setq k (1+ k))
 )
 (setq nrs (strcat sk nrs))
 (princ nrs)
)

Va multumesc anticipat si va doresc o zi buna.

[John Doe]

Uite altceva mai simplu, doar ca e pentru creare carnet de teren in format CSV. Iti cere punctul de statie si de orientare, poti sa dai doua complet aiurea si in rest obtii ce vrei tu.

Cod [Selectează] Extinde


;;;Pentru generare carnet de teren
;;;trebuie sa avem pe plan polilinii si punctele de statie si de orientare; liniile nu se pun, deocamdata
;;;Genereaza lânga desen fisierul CARNET.csv in forma:  [PS]  [PV]  [X]  [Y]  [Dx]  [Dy]  [Dist redusa]  [Orientare]
;;;numerotarea pleaca de la nr. 100 in carnet, punctele se pot pune sau nu pe ecran
;;;punctul de orientare se citeste si el oricum, asa ca il scriem si in carnet

(command "units" "2" "3" "3" "4" "0.0000" "N")
(graphscr)


(defun C:CARNET ()
(setq msel (ssget (list (cons 0 "LWPOLYLINE")(cons 410 "MODEL"))))
(setq lng (sslength msel))
(setq index 0)
(setq ncor (getint "\nNumerotare puncte începând cu <100>: "))
(if (= nil ncor)(setq ncor 100))
(setq des "q")
(while (AND (/= des "y")(/= des "Y")(/= des "n")(/= des "N")(/= des ""))
(setq des (getstring "\nScriem numarul punctelor pe desen? Yes/No <Y>:"))
);;;while
(if (= des "")(setq des "Y"))
(setq des (strcase des))
(setq fis (open "Fiscord.txt" "w"));;;---asta e temporar, va fi sters la sfarsit

(while (< index lng)
(setq nent (ssname msel index))
(setq index (+ 1 index))
(setq lent (entget nent))
(setq cont 0);;;numar de ordine al componentelor entitatii-lista, si daca da de codul de grup 10  extrage coordonatele
(while (setq entc (nth cont lent))
(setq cont (+ 1 cont))
(if (= 10 (car entc))(progn
(setq ncor (+ 1 ncor))
(write-line (itoa ncor) fis)
(setq x (cadr entc))
(write-line (rtos x 2 3) fis)
(setq y (caddr entc))
(write-line (rtos y 2 3) fis)
(if (= des "Y")(command "text" (list (+ 1 x) (+ 1 y)) 3 0 ncor))

));;PROGN si IF
);;WHILE pe fiecare entitate
);;;WHILE de la index entitati
(close fis)

;;;------------------Acum avem fisierul de coordonate, il citim si facem carnetul de teren

(setvar "osmode" 8);;;------------pentru "Node"
(setq ps (getpoint "\nSELECTATI PUNCTUL DE STATIE:"))
(setq nps (getstring "\nNUMAR PUNCT STATIE: "))
(setq po (getpoint "\nSELECTATI PUNCTUL DE ORIENTARE:"))
(setq npo (getstring "\nNUMAR PUNCT DE ORIENTARE: "))
(setq ys (nth 0 ps))
(setq xs (nth 1 ps))
(setq yo (nth 0 po))
(setq xo (nth 1 po))
(setq dx (- xo xs));;;---real
(setq dy (- yo ys));;;---real
(setq dist (distance ps po));;;---real
(setq orient (angle ps po))
(setq orient (angtos orient 2 4));;;---string
(setq orient (atof orient))

(if (AND (> dx 0) (> dy 0))(setq orient (- 100 orient)));;;---cadran 1
(if (AND (> dx 0) (< dy 0))(setq orient (- 500 orient)));;;---cadran 2
(if (AND (< dx 0) (< dy 0))(setq orient (- 500 orient)));;;---cadran 3
(if (AND (< dx 0) (> dy 0))(setq orient (- 500 orient)));;;---cadran 4

(setq cale (getvar "dwgprefix"))
(setq fis2 (open (strcat cale "Carnet.csv") "w"))
(write-line (strcat "Punct statie: " nps) fis2)
(write-line (strcat "Punct orientare: " npo ) fis2)
(write-line "" fis2)
(write-line "" fis2)
(write-line "PS,PV,X,Y,Dx,Dy,Dist. red.,Orientare" fis2)
(write-line (strcat nps "," npo "," (rtos xo) "," (rtos yo) "," (rtos dy) "," (rtos dx) "," (rtos dist) "," (rtos orient 2 4) ) fis2)

(setq nfis1 (open "Fiscord.txt" "r" ))

;;;---------------citim pe rand fiecare linie din fisier
(while (setq np (read-line nfis1))
(setq yp (read-line nfis1))
(setq xp (read-line nfis1))
(setq xp (atof xp))
(setq yp (atof yp))
(setq dx (- xp xs))
(setq dy (- yp ys))
(setq dist (distance ps (list yp xp)))
(setq orient (angle ps (list yp xp)))
(setq orient (angtos orient 2 4));;;string
(setq orient (atof orient))
(if (AND (> dx 0) (> dy 0))(setq orient (- 100 orient)));;;---cadran 1
(if (AND (> dx 0) (< dy 0))(setq orient (- 500 orient)));;;---cadran 2
(if (AND (< dx 0) (< dy 0))(setq orient (- 500 orient)));;;---cadran 3
(if (AND (< dx 0) (> dy 0))(setq orient (- 500 orient)));;;---cadran 4

(write-line (strcat "," np "," (rtos xp) "," (rtos yp) "," (rtos dy) "," (rtos dx) "," (rtos dist) "," (rtos orient 2 4) ) fis2)

);;;while de la citire fisier
(close nfis1);;;inventarul de coordonate
(close fis2);;;carnetul de teren

(command "sh" "del Fiscord.txt")
(setq linie (strcat "Fisierul CARNET.csv a fost creat in locatia:  \n" cale ))
(alert linie)
);;;defun CARNET



(alert "Pentru generate carnet de teren, dati comanda CARNET")



[zamfy]

Facut in 10 minute.
Vezi daca iti e de ajutor.
Ruleaza cu comanda csv.

Cod [Selectează] Extinde

(defun c:csv (/)
(setvar "CMDECHO" 0)
(setq path (getvar 'dwgprefix))
(setq index (getint "\nAlege index-ul <1>: "))
(if (not index)
(setq index 1)
)
(setq fiscoord (open (strcat path "Coordonate_" (itoa index) ".csv") "w"))
(if
(setq polilinie (car (entsel "\nAlegeti polilinia pentru care doriti sa exportati fisierul de coordonate:")))
(progn
(setq ss1 (ssget "X" '((0 . "INSERT")(66 . 1))))
(if ss1
(progn
(setq count 0)
(while (< count (sslength ss1))
(setq en (ssname ss1 count))
(setq cen (entget en))
(setq nbloc (cdr (assoc 2 cen)))
(if (or (= "PUNCT" (strcase nbloc)) (= "POINT" (strcase nbloc)))
(progn
(setq basepoint (cdr (assoc 10 cen)))
(if (member (list (car basepoint) (cadr basepoint)) (list-lwp polilinie))
(progn
(setq edata (entget (entnext (dxf -1 cen))))
(setq denumire (dxf 1 edata))
(setq edata (entget (entnext (entnext (dxf -1 cen)))))
(setq z (dxf 1 edata))
(setq edata (entget (entnext (entnext (entnext (dxf -1 cen))))))
(setq cod (dxf 1 edata)) 
(write-line (strcat denumire "," (rtos (cadr basepoint)) "," (rtos (car basepoint)) "," z "," cod) fiscoord)
)
)
)
)
(setq count (1+ count))
)
)
)
)
)
(close fiscoord)
(princ (strcat "\nFisierul Coordonate_" (itoa index) ".csv a fost generat cu succes!"))
(princ)
)


(defun list-lwp (ele)
  (mapcar 'cdr  (vl-remove-if '(lambda(x) (/= (car x) 10)) (entget ele)))
)


(defun dxf (code elist)

  (cdr (assoc code elist))
  )


[zamfy]

@phibrizzo, iti trebuie cumva pentru receptii tehnice pentru proiecte finantate prin PNDL? 

[phibrizzo]

Nu stiu inca pentru ce sunt documentatiile ca nu sunt ale mele, ajut un coleg cu partea de birou si inca nu am inceput(ridicari la drumuri). Cerusem ajutorul cu lispul respectiv deoarece se pare ca la oficiul unde le va depune i s-a cerut ca denumirile punctelor de contur ce delimiteaza suprafata studiata sa se regasesca si in carnetul de teren iar selectarea manuala a acestora e destul de anevoioasa.
        Multumesc pentru ajutor, ambele merg foarte bine doar ca cea facuta de zamfi imi ia direct si numele punctului si de asta aveam nevoie. O zi buna.