Scripturi in LISP AutoLISP

DAN.ARBA · Oct 30, 2010, 05:38 PM

Pentru desenarea unui triunghi oarecare cand se cunosc doar laturile triunghiului:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; script autolisp realizat de Dan Arba; ;;;
;;; adresa email: E-mail ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:trio ()
(setq mag (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)

(setq D1 (getdist "\nIntroduceti latura AB:")
D2 (getdist "\nIntroduceti latura BC:")
D3 (getdist "\nIntroduceti latura AC:"))

(if (and (< (abs (- D1 D2)) D3) (< D3 (+ D1 D2))
(< (abs (- D1 D3)) D2) (< D2 (+ D1 D3))
(< (abs (- D2 D3)) D1) (< D1 (+ D2 D3)))
(PROGN (setq A (getpoint "\nPrecizati coltul A al triunghiului:")
B (list (+ D1 (car A)) (cadr A))
L (/ (- (expt D3 2) (+ (expt D1 2) (expt D2 2))) (* 2 D1))
H (sqrt (- (expt D2 2) (expt L 2)))
C (list (+ L (car B)) (+ H (cadr A))))
(cond ((> (car B) (car C))
(setq intBC (list (car B) (cadr C))))
((> (car C) (car B))
(setq intBC (list (car C) (cadr C))))
((equal (car B) (car C))
(setq intBC (list (car B) (cadr C))))
)
(command "_zoom" "window" a intBC)
(command "pline" A B C "c" "")
(colturi AAA BBB CCC D1 D2 D3 notA notB notC)
)
(alert (strcat "\nNu este indeplinita conditia de existenta al triunghiului!"
"\n A se vedea conditia lui Herron!"))
)
(setvar "osmode" mag)
)
(defun colturi (AAA BBB CCC D1 D2 D3 notA notB notC)
(setq MINIM (min D1 D2 D3))
(setq ZECIMEDEMINIM (/ MINIM 10))
(setq notA (getstring T "\nColtul 1 al triunghiului:"))
(setq notB (getstring T "\nColtul 2 al triunghiului:"))
(setq notC (getstring T "\nColtul 3 al triunghiului:"))
(setq AAA (list (- (car A) ZECIMEDEMINIM) (cadr A)))
(setq BBB (list (+ (car B) ZECIMEDEMINIM) (cadr B)))
(setq CCC (list (car C) (+ ZECIMEDEMINIM (cadr C))))
(command "text" AAA ZECIMEDEMINIM 0 notA "")
(setq ob1 (ssget "l"))
(command "text" BBB ZECIMEDEMINIM 0 notB "")
(setq ob2 (ssget "l"))
(command "text" CCC ZECIMEDEMINIM 0 notC "")
(setq ob3 (ssget "l"))
(command "_zoom" "o" ob1 ob2 ob3 "")
)

Modificat de DAN.ARBA (30-10-2010 22:22:49)

DAN.ARBA · Oct 30, 2010, 05:51 PM

daca e cineva interesat - am foarte multe scripturi ,insa destule dintre ele nu sunt bine puse la punct , le-am scris in graba in functie de ceea ce aveam de lucru in acel moment, dar se pot folosi ,chiar daca nu sunt foarte clar definite . Cel mai important pentru voi topografii (corectat la observatia lui diagodose2009) cred ca e importul si exportul de puncte. Cand vine vorba de puncte, am intalnit atatea situatii cati topografi ; unii aveau punctele in blocuri cu atribute ,altii in format text , altele desi aveau in atribut si cote ele erau inserate doar in plan ... sau unele care nu aveau nici macar elevatia atasata(indicata). Pentru aceste situatii a trebuit sa adaptez diverse scripturi pentru a le aduce la un model comun de lucru.
Exemplu mai concret :
Ridicare puncte podete . Desi erau inscrise cotele , ele erau situate in plan ,dar deja fiind unite intre ele conform situatiei din teren , cele mai multe manual (mentionez ca era vorba de multe poduri si podete) nu mai era rentabil sa le faci din nou ca sa fie 3D. Asa ca in autolisp am reusit sa le remodelez fortat 3D fara sa se piarda toate trasarile dintre ele si nici straturile sau tipul de linie.

Modificat de DAN.ARBA (06-11-2010 23:42:28)

DAN.ARBA · Oct 30, 2010, 05:57 PM

Va mai dau unul frumusel pentru selectie filtrata . Land Desktop are implementata comanda pentru asta, dar autocadul nu prea (adica are ceva ,dar e mai pretentios . ma refer la quic select):

Aici postez interfata de dialog. Trebuie salvata cu numele " sssdcl.dcl " undeva unde autocadul are deja facuta o cale (un path) ,de pilda direct in " C:\Program Files\AutoCAD 2009 " ... sau ,ma rog, ce autocad folositi.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------------------------------------------;;;
;;;---DCL realizat de : Dan Arba------------------------;;;
;;;--- adresa email: E-mail ------------------------;;;
;;;-----------------------------------------------------------------;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Executa selectie similara pe un sector rectangular sau poligonal;;
;;; indicat la alegere printr-un patrulater sau printr=un poligon ;;
;;; deschis.
;;; Are si otpiunea pe intreg spatiul model ,atunci nefiind necesara;;
;;; indicarea zonei.
;;; Cauta obiectele dupa strat si tip de entitate.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
sssdcl : dialog {
label = "selectie similara " ;
: column {
: row {
: spacer {
width = 7;
//height = 1;
}
: text {
key = "t5" ;
value = "Includeti toate elementele selectate? " ;
width = 35 ;
}
}
: boxed_column {
label = "tip selectie" ;
: radio_column {
key = "radios";
: radio_button {
label = "retineti toate obiectele";
key = "full";
value = "1";
}
: radio_button {
label = "doar zona selectata";
key = "selectare";
value = "0";
}
}
}
: boxed_column {
label = "limite" ;
: row {
: text {
key = "t1";
value = "selectati o zona de cautare";
width = 24;
}
: button {
key = "rectangular";
label = "rectangular";
width = 1;
height = 1;
is_default = false;
}
}

: row {
: text {
key = "t2";
value = "tot spatiul model";
width = 23;
}
: button {
key = "nelimitat";
label = " Nelimitat ";
width = 1;
height = 1;
is_default = true;
is_cancel = true;
}
}
: row {
: text {
key = "t7";
value = "Poligonal (pt. a termina apasati click dreapta)";
width = 35;
}
: button {
key = "poligonal";
label = " poligonal ";
width = 1;
height = 1;
is_default = false;
is_cancel = true;
}
}
}
: row {
: spacer {
width = 10;
//height = 1;
}

: button {
key = "cancel";
label = " Cancel ";
is_default = false;
width = 8;
height = 1 ;
is_cancel = true;
}
: spacer {
width = 10;
//height = 1;
}
}
}
}

//pentru sss_dcl_final , face selectie filtrata cu fereastra de dialog

Modificat de DAN.ARBA (01-08-2011 15:00:50)

DAN.ARBA · Oct 30, 2010, 06:09 PM

;;;Iar acesta functioneaza doar cu cel postat mia sus (sssdcl.dcl):
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------------------------------------------;;;
;;;---script autolisp realizat de : Dan Arba------------------------;;;
;;;---adresa email: E-mail ------------------------;;;
;;;-----------------------------------------------------------------;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Executa selectie similara pe un sector rectangular sau poligonal;;
;;; indicat la alegere printr-un patrulater sau printr=un poligon ;;
;;; deschis.
;;; Are si otpiunea pe intreg spatiul model ,atunci nefiind necesara;;
;;; indicarea zonei.
;;; Cauta obiectele dupa strat si tip de entitate ( o sa mai adaug in viitor si lista de optiuni pentru filtre)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mai jos ultima versiune revizuita ( am corectat si partea cu selectia poligonala)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(DEFUN c:sss ()
(setq mag (getvar "osmode"))
(setvar "osmode" 0)
(setvar "snapmode" 0)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq obiecte (ssget "_I")) ;;;------------------- trebuie pus inaintea oricarei "command" ,altfel ;se debifeaza
;;(command "undo" "begin")
;;;--- daca nu avem selectat anterior nici un obiect selectam acum

(if (equal obiecte nil)
(setq obiecte (ssget)))
(sssetfirst obiecte obiecte)

;;;--- gata selectare anterioara
;;--------resetam variabilele

(setq nume nil lung nil i nil nume nil strat nil lisnume nil lisstrat nil lfn nil lfs nil LUNGLISNUME NIL numej nil nume-strat nil
j nil k nil lista_filtre nil numejj nil lista_prefinala nil numel nil listal nil fil1 nil filtre nil fil nil lunglf nil p nil li nil ;;; aici sunt si elemente in plus aparute de la multiple incercari pe care nu le-am mai sters ;ulterior
sector nil p1 nil p2 nil punct nil poligon nil sector nil elemente nil )

(sssetfirst nil obiecte)
(setq lung (sslength obiecte)
i 0
)

;;---intocmire lista NUME

(while (<= i (- lung 1))
(setq nume (assoc 0 (entget (ssname obiecte i))))
(if (= (member nume lisnume) nil)
(setq lisnume (append (list nume) lisnume))
)
(setq i (1+ i))
)
(setq lunglisnume(length lisnume)
j 0
)

;;---gata lista cu (0 . "nume")
;;---intocmire lista cu straturi pentru fiecare nume in parte

(while (<= j (- lunglisnume 1))
(setq numej (list(nth j lisnume))
k 0
)
(while (<= k (- lung 1))
(if (and (equal (list(assoc 0 (entget(ssname obiecte k)))) numej)
(equal (member (cons 8 (cdr(assoc 8 (entget(ssname obiecte k))))) numejj) nil)
)
(setq numejj (append(list(assoc 8 (entget(ssname obiecte k)))) numejj)
k (1+ k)
)
(setq k (1+ k))
)
(princ)
)
(setq lista_prefinala (append numej numejj)
lista_filtre (append lista_prefinala lista_filtre)
numejj nil
)
(setq j (1+ j))
)
(setq lisnume(reverse lisnume))

;;;---gata lista cu straturi pentur fiecare nume in parte
;;;---prelucrare lista finala pentru selectia filtrata

(setq lunglf (length lista_filtre)
p 0
q 0
FILTRE lista_filtre
)
;;;;;;;;;;;;;;;;;;;;
;;; DEOARECE AVEM j LISTE CU NUME,O SA REPETAM DE j ORI ,PENTRU FIECARE NUME IN PARTE
(setq li5 (list(cons -4 "or>")))
(repeat j
(setq li (list (nth q lisnume)))
(setq p (1+ p)) ;;;;;;;;;;;; il incrementam cu 1 ca ;sa nu se opreasca pe (0 . "nume")
(while (equal (car(nth p lista_filtre)) (read "8"))
(setq li (append (list(nth p lista_filtre)) li))
(setq p (1+ p))
)
;;;--- trebuie sa transformam cdr-ul din (8 . "strat") in "stringuri" unite prin "," intre ele daca ;sunt mai multe
(progn
(setq r 0
lungli (length li)
li2 ""
)
(while (= (car(nth r li))

(setq li2 (strcat (cdr (nth r li)) "," li2))
(setq r (1+ r))
)
(setq li3 (cons 8 li2))
)
;;;--- gata transformare straturi in sir de caractere
(setq q (1+ q)
li4 (list (cons -4 "<and") (last li) li3 (cons -4 "and>"))
li5 (append li4 li5)
))
(setq li6 (append (list (cons -4 "<or")) li5))

;;;--- gata lista intocmita pentru ssget
;;------------------------------stabilirea zonei de cautare (limitat sau nelimitat)-----------------
;;(initget "R r N n P p ")
;(setq sector (getkword "\n [Sector/Nelimitat]: ?"))
;;;;;;;;;;;;;-----------------------------fereastra dialog DCL---------------------
(setq dcl_id (load_dialog "sssdcl.dcl"))
(if (not (new_dialog "sssdcl" dcl_id) ) (exit))
(action_tile "rectangular" "(setq ddiag 1)(saveVars)(done_dialog)")
(action_tile "nelimitat" "(setq ddiag 2)(done_dialog)")
(action_tile "poligonal" "(setq ddiag 4)(saveVars)(done_dialog)")
(action_tile "cancel" "(setq ddiag 3)(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
(cond ((= ddiag 1) (setq sector "R")) ;;---sector rectangular
((= ddiag 2) (setq sector "N")) ;;---sector nelimitat
((= ddiag 4) (setq sector "P")) ;;---sector poligonal
((= ddiag 3) (setq elemente nil))
)
;;;;;;;;;;;;;-----------------------------gata fereastra dialog DCL---------------------
(cond ((equal sector "R")
(progn (setq p2(getcorner (setq p1(getpoint "\nPunctul p1:")) "\nPunctul p2:")
elemente (ssget "w" p1 p2 li6)
)

))
((equal sector "P")
(rlf) ;;;regen-line-false + linie elastica

(setq elemente (ssget "wp" poligon li6))
)

((= sector "N") (progn (setq elemente (ssget "x" li6))(sssetfirst nil elemente)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq afis1 (strcat "\n S-au adaugat " (itoa (sslength elemente)) " entitati")
afis2 "\n Asteptati cateva secunde dupa ce apasati OK !")

(if (> (sslength elemente) 100)
(alert (strcat afis1 afis2))
(alert afis1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(command "_undo" "end")
;;(command "redraw" )

(cond ((= radio1 1)
(progn
(setq h 0)
(repeat (sslength obiecte)
(setq elemente(ssadd (ssname obiecte h) elemente)
h (+ h 1))
)
(sssetfirst nil elemente)))
((= radio2 1)(sssetfirst nil elemente))
)

(setvar "osmode" mag)

)
;;;--------------------------gata program selectie filtrata---------------------------------------
;;;;;;;;;;;;;; determinare prin "click pe radio" daca se retin toate obiectele,adica si cele initial ;selectate daca sunt inafara zonei de selectie
(defun saveVars()
(setq radio1(atoi(get_tile "full")))
(setq radio2(atoi(get_tile "selectare")))

)
;;;;;;;;;;;;;;gata determinare conditie "radio selectie"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;mai jos alcatuirea poligonului de selectie

(defun gr ( ) ;;;grdraw-repeat - afiseaza continuu liniile false ale poligonului
(setq jj 0)
(setq lungime2 (length poligon))
(if (cdr poligon)
(repeat (- lungime2 1)
(grdraw (nth jj poligon) (nth (+ jj 1) poligon) 3 1)
(setq jj (+ 1 jj))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN rlf () ;(REGEN-LINE-FALSE)
(setq punct nil poligon nil)

(setq punct (getpoint "start poligon")
poligon (append (list punct) poligon)
)

(while (/= (car (setq pp1(grread t 1))) 25)
(cond ((= (car pp1) 5)
(redraw)
(gr)
(grdraw punct (cadr pp1) 2 1)
(grdraw (last poligon) (cadr pp1) 2 1)
)
((= (car pp1) 3)
(gr)
(setq punct (cadr pp1)
poligon (append (list punct) poligon)
)
(grdraw (last poligon) (car poligon) 2 1)
)
)
)
)

Modificat de DAN.ARBA (01-08-2011 15:05:19)

DAN.ARBA · Oct 30, 2010, 06:14 PM

E ok acum. Am corectat si partea de la poligonal (mai sus varianta revizuita).

"Aveti posibilitatea de-a retine si obiectele deja selectate (chiar daca sunt de de diferite categori ) sau doar pe cele din sectorul indicat . La varianta POLIGONAL mai trebuie sa lucrez ; nu dati zoom in timp ce trasati zona de selectie! Le-am scris pe baza comenzilor de "grredraw" si dispar liniile la regen.

http://www.3xforum.ro/img/smilies/sad.png"> "

581/286px 26.2KB

Modificat de DAN.ARBA (01-08-2011 15:06:44)

shury · Noi 02, 2010, 06:14 PM

Salut sunt nou pe aici , adica de urmarit va urmaresc de vreo 2-3 ani dar e prima data cand scriu

http://www.3xforum.ro/img/smilies/smile.png">. John Doe as dori si eu cateva aplicatii si lisp uri. sunt interesante si cred ca ma vor ajuta. Deasemenea as fi interesat de aplicatia lui Marian de generare cp automata. ms anticipat

John Doe · Noi 03, 2010, 10:52 AM

Chestie de gusturi... eu folosesc Qselect si merge destul de bine.
Referitor la metodele topografilor (nu tipografilor, Dane!): este un compromis intre ceea ce poate individul, ce i se cere si ce are la dispozitie. Si ce e mai ieftin. Nu intotdeauna e si solutia cea mai simpla, dar daca functioneaza...

John Doe · Noi 20, 2010, 08:33 PM

Uneori ni se cere si un fel de carnet de teren care sa contina distante, orientari, etc. , care seamana cu fisierul IDX dar nu e intotdeauna usor de obtinut. Postez mai jos o aplicatie LISP care poate ajuta; dati "paste" la cod intr-un fisier text si schimbati extensia fisierului in LSP si se poate folosi.

Code:

;;;----------------------CARNET  DE  TEREN----------------------
;;;trebuie sa avem pe plan polilinii si punctele de statie si de orientare - entitati POINT, asa s-a setat OSMODE
;;;Genereaza fisierul CARNET.csv in forma:  [PS]  [PV]  [X]  [Y]  [Dx]  [Dy]  [Dist redusa]  [Orientare] , pentru toate vertexurile poliliniilor din desen
 

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


(defun C:CARNET ()
(setq msel (ssget "X" (list (cons 0 "LWPOLYLINE"))))
(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" ;;;------------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")

doara.florin · Noi 21, 2010, 06:55 PM

Tyyyy 10x John.

http://www.3xforum.ro/img/smilies/hi.png">

kod · Noi 21, 2010, 07:35 PM

Foarte buna aplicatia, dar am cateva intrebari, nedumeriri:
Daca am mai multe statii din care am ridicat imobilul, practic aplicatia imi ia in considerare doar cea pe care eu o selectez nu ?
Si cum anume este gandita rutina, adica ce puncte radiate ia in considerare, tot ce am pe plan sau doar toate punctele care intra in constructia unei polilinii ?
Dar daca am mai multe polilinii ?

Nu o lua ca pe o mustrare sau o indicatie, ci doar vreau sa stiu cum anume a fost gandita, cum anume numeroteaza punctele (banuiesc ca de la statia de baza in sens direct matura tot ce iese la iveala nu ? ) sau ma insel ?

John Doe · Noi 22, 2010, 11:05 AM

Carnetul de teren e pentru OCPI, care asa cere. Poliniliile le folosesc eu, sunt mai eficiente. Nu pot face aplicatii universale, pentru toate situatiile si stilurile de lucru, deci ramane cam pe gusturile mele... dar crede-ma, doua zile m-am tot gandit pana am facut aplicatia.

Ideea este cam asa: din desenul tau, iei cu copy elementele fiecarui punct de statie: poliliniile cu care ai unit punctele, statia si punctul pe care te-ai orientat, si le dai paste in coordonate intr-un desen nou. Incarci aplicatia, dai comanda si ai fisierul CSV. Atentie, fisierul are acelasi nume chiar daca e alta statie si o sa-ti scrie peste el, daca il ai acolo de la statia precedenta. Redenumeste-l sau muta-l inainte de a porni aplicatia.
Operatia se repeta pentru fiecare punct de statie separat.
Se poate face carnetul si pentru tot desenul deodata, prin mai multe seturi de selectii, dar e mult prea complicat ca sa fie rentabil.

Elementele sunt legate intre ele... faptic: punct de statie, punct de orientare, elemente radiate din statia aia unite cu polilinii.

Am folosit polilinii si nu puncte fiindca s-ar putea ca multi sa-si fi raportat punctele cu tot felul de alte programe, care folosesc diverse elemente in loc de puncte si m-as fi trezit cu o gramada de intrebari ca de ce nu merge... (fiindca nici o fapta buna nu ramâne nepedepsita, nu?).
Poliliniile si punctele sunt numerotate in ordinea in care sunt ele in desen, adica in ordinea in care au fost desenate. Unii ai nevoie doar de carnetul de teren ca foaie cu calcule de predat la OCPI, iar cine vrea sa faca si corespondenta dintre calcule si teren poate sa-si numeroteze punctele.

masterat0r · Noi 24, 2010, 05:35 PM

selectie entitati dupa atribute sau layere si multe alte functii : CADTOOLS http://www.glamsen.se/Download/CadTools/CadTools_setup.EXE" target="_blank">http://www.glamsen.se/Download/CadTools ... _setup.EXE

kod · Noi 24, 2010, 08:32 PM

John Doe a scris:

Carnetul de teren e pentru OCPI, care asa cere. Poliniliile le folosesc eu, sunt mai eficiente. Nu pot face aplicatii universale, pentru toate situatiile si stilurile de lucru, deci ramane cam pe gusturile mele... dar crede-ma, doua zile m-am tot gandit pana am facut aplicatia.

Ideea este cam asa: din desenul tau, iei cu copy elementele fiecarui punct de statie: poliliniile cu care ai unit punctele, statia si punctul pe care te-ai orientat, si le dai paste in coordonate intr-un desen nou. Incarci aplicatia, dai comanda si ai fisierul CSV. Atentie, fisierul are acelasi nume chiar daca e alta statie si o sa-ti scrie peste el, daca il ai acolo de la statia precedenta. Redenumeste-l sau muta-l inainte de a porni aplicatia.
Operatia se repeta pentru fiecare punct de statie separat.
Se poate face carnetul si pentru tot desenul deodata, prin mai multe seturi de selectii, dar e mult prea complicat ca sa fie rentabil.

Elementele sunt legate intre ele... faptic: punct de statie, punct de orientare, elemente radiate din statia aia unite cu polilinii.

Am folosit polilinii si nu puncte fiindca s-ar putea ca multi sa-si fi raportat punctele cu tot felul de alte programe, care folosesc diverse elemente in loc de puncte si m-as fi trezit cu o gramada de intrebari ca de ce nu merge... (fiindca nici o fapta buna nu ramâne nepedepsita, nu?).
Poliliniile si punctele sunt numerotate in ordinea in care sunt ele in desen, adica in ordinea in care au fost desenate. Unii ai nevoie doar de carnetul de teren ca foaie cu calcule de predat la OCPI, iar cine vrea sa faca si corespondenta dintre calcule si teren poate sa-si numeroteze punctele.

Da, ai dreptate nu poti sa te adaptezi pt. toti, cred ca ti-a dat ceva de gandit, ma bucur ca ai reusit sa-i dai de cap pana la urma, de asta am si intrebat care a fost logica. (la fel m-am gandit si eu)
O seara faina

http://www.3xforum.ro/img/smilies/wink.png">

advex · Noi 24, 2010, 08:39 PM

masterat0r a scris:

selectie entitati dupa atribute sau layere si multe alte functii : CADTOOLS http://www.glamsen.se/Download/CadTools/CadTools_setup.EXE" target="_blank">http://www.glamsen.se/Download/CadTools ... _setup.EXE

Aplicatia a mai fost semnalata la http://topograf.3xforum.ro/post/2092/1/Utilitar_CadTools_pt_AutoCAD/" target="_blank">http://topograf.3xforum.ro/post/2092/1/ ... t_AutoCAD/

Aici au sunt postate fisiere autolisp distincte, descoperite pe net sau creatie proprie, utile topografilor.

_______________________________________
http://info-topograf.blogspot.ro/" target="_blank">http://info-topograf.blogspot.ro/

John Doe · Noi 25, 2010, 10:10 AM

Uneori, cand avem de facut un tabel cu inventarul de coordonate ale punctelor unui contur apar unele chestiuni neplacute, sau daca sunt prea inghesuite punctele e ceva de lucru pana le aranjam.
Postez mai jos o aplicatie care numeroteaza punctele unui contur, le scrie pe plan si face si inventarul de coordonate cu "S=xxx mp" scris sub el, dar punctele sunt aranjate dupa alt algoritm. Ideea este sa scrie numarul punctului cu alta aliniere (stanga, dreapta, sus sau jos) functie de cadranul in care este segmentul la capatul caruia pune punctul.
Luati textul cu copy si dati paste intr-un fisier text gol, la care îi schimbati extensia in LSP si va merge. NU se ia si cuvantul "Code:", ala e scris automat de site.
Codul e scris destul de labartat, are si comentarii, tocmai ca sa poata fi inteles si modificat si de voi in functie de ce aveti nevoie concret.
Variabila "ofs" este offsetul la care scrie textul intr-o parte sau alta fata de punctul geometric, "alfa" este orientarea segmentului de dreapta, etc. - am folosit denumiri cat mai sugestive.
Exista mai multe optiuni de plasare a tabelului cu inventarul de coordonate, acum functioneaza cea mai potrivita pentru mine dar se poate anula cu ";;;" in fata liniilor corespunzatoare si se pate activa alta optiune daca stergeti ";;;" din fata liniilor de cod.

Code:

;;;pentru planse de parcelare OCPI - numeroteaza punctele de contur si face tabelul cu inventarul de coordonate

(defun C:TAB ()
(setq osn_old (getvar "osmode"))
(setvar "osmode" 0)
(command "pdmode" 35)
(command "pdsize" 1.5)
(command "ortho" "off")
(command "units" "2" "3" "3" "4" "0.0000" "N")
(graphscr)
(command "-style" "Arial" "Arial.ttf" 0 1 0 "N" "N")

(setq pi2 (/ pi 2))
(setq 5pi2 (/ (* 5 pi) 2))
(setq 2pi (* pi 2))
(setq 3pi2 (/ (* pi 3) 2))
(setq mselt (ssadd))


(setq sel (car(entsel "\nSelectati conturul:")));;;----obiect
(setq msel (entget  sel));;;-----lista
(setq lng (length msel))

;;;---------------ar trebui sa vedem cate vertexuri are, ca se suprapune ultimul cu primul
(setq index1 0)
(setq nmax 0)
(while (< index1 lng)
    (setq nent1 (nth index1 msel))
    (setq index1 (+ 1 index1))
    (setq cod1 (car nent1))
    (if (= 10 cod1)(setq nmax (+ 1 nmax)));;;asta e nr. maxim de puncte
                );;;while
(setq nmax (- nmax 1))
;;;-------------acuma le luam pe rand si scriem
(setq index 0)
(setq ncor 0)
(while (< index lng)
(setq nent (nth index msel));;;element de lista
(setq index (+ 1 index))
(setq cod (car nent))
        (if (AND (= 10 cod)(<= ncor nmax))(progn 
            (setq ncor (+ 1 ncor))
            (setq y (cadr nent))
            (setq x (caddr nent))
            (command "point" (list y x));;;parantezele se inchid mai incolo

        (if (= ncor 1)(progn
            (command "text" (list (+ 1 y) (+ 1 x)) 3 0 ncor)
            (setq pant (list y x))
                    ));;;PROGN+IF ncor=1
        (if (> ncor 1)(progn
            (setq alfa (angle pant (list y x)))
            (setq dist (distance pant (list y x)))
            (setq ofs 3)
            (if (<= alfa pi2)(setq alfa1 (- alfa 5pi2)))
            (if (> alfa pi2)(setq alfa1 (- alfa pi2)))
            (if (< dist 5)(setq alfap 1)(setq alfap 0))
            (if (AND (< distant 5)(= alfant 1))(setq alfap 0))
            (setq alfa1 (+ alfa1 (* alfap pi)))
            (setq aabs (abs alfa1))
            (if (> aabs 2pi)(setq aabs (- aabs 2pi)))
            (if (AND (>= aabs 0)(< aabs pi2))(setq jt "BL"))
            (if (AND (>= aabs pi2)(< aabs pi))(setq jt "BR"))
            (if (AND (>= aabs pi)(< aabs 3pi2))(setq jt "TR"))
            (if (AND (>= aabs 3pi2)(< aabs 2pi))(setq jt "TL"))
            (setq dx (* ofs (cos alfa1)))
            (setq dy (* ofs (sin alfa1)))
            (command "text" "J" jt (list (+ y dx) (+ x dy)) 3 0 ncor)
            (setq pant (list y x))
            (setq distant dist)
            (setq alfant alfap)
                        ));;;PROGN+IF ncor>1
;;;=================pentru liniile cap de tabel===========================luam X, Y pentru tabel de aici
            (if (= ncor 1)(progn 
                (setq xs y)
                (setq ys x)
                (setq ps (list y x))
                (command "text" (list xs (+ ys 5)) 3 0 "Nr            X                 Y")
                (setq mselt (ssadd (entlast) mselt))
                (command "line" (list (- xs 1) (+ ys 4)) (list (+ xs 55) (+ ys 4)) "");;;linia de sub Nr....X....Y
                (setq mselt (ssadd (entlast) mselt))
                (command "line" (list (- xs 1) (+ ys 9)) (list (+ xs 55) (+ ys 9)) "");;;linia de deasupra Nr...X...Y
                (setq mselt (ssadd (entlast) mselt))
                                ));;;PROGN si IF ncor=1
;;;==================================================================================
            (if (< ncor 10)(setq sp "     "))
            (if (AND (< ncor 100)(>= ncor 10))(setq sp "   "))
            (if (>= ncor 100)(setq sp " "))
            (setq lin (strcat (itoa ncor) sp (rtos x 2 3) " " (rtos y 2 3)))
            (setq yc (- ys (* (- ncor 1) 4.))
                    (command "text" (list xs yc) 3 0 lin)
                    (setq mselt (ssadd (entlast) mselt))
                    (command "line" (list (- xs 1) (- yc 1)) (list (+ xs 55) (- yc 1)) "")
                    (setq mselt (ssadd (entlast) mselt))
                                        ));;PROGN si IF  cod=10
                                        );;;WHILE de la index lista entitati

;;;---------- liniile verticale
(command "line" (list (- xs 1) (+ ys 9)) (list (- xs 1) (- yc 1)) "");;;verticala din stanga
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (+ xs 7.7) (+ ys 9)) (list (+ xs 7.7) (- yc 1)) "");;;verticala dintre numar si X
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (+ xs 30.85) (+ ys 9)) (list (+ xs 30.85) (- yc 1)) "");;;verticala dintre X si Y
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (+ xs 55) (+ ys 9)) (list (+ xs 55) (- yc 1)) "");;;ultima
(setq mselt (ssadd (entlast) mselt))

;;;-----------acuma sa vedem ce suprafata are
(command "area" "ob" sel)
(setq supraf (getvar "area"))
(setq sint (fix supraf))
(setq dif (- supraf sint))
(if (>= dif 0.5)(setq supraf (+ 1 sint)))
(setq supraf (rtos supraf 2 0))
(command "text" (list (+ xs 12) (- yc 5)) 3 0 (strcat "S=" supraf " mp"))
(setq mselt (ssadd (entlast) mselt))


;;;-------------acum sa facem conturul gros de 0.8 ca se vede mai bine
(command "pedit" sel "W" 0.8 "")

;;;=================================aici avem mai multe optiuni===============================
;;;OPTIUNEA 1: facem bloc, si il inseram dupa aia
(if (= nil bn)(setq bn 1)(setq bn (+ 1 bn)))
(setq bname (strcat "b" (itoa bn)));;;construim numele blocului, ca sa nu se suprapuna cu altele
(command "-block" bname ps mselt "");;;il ascunde cu totul si trebe inserat dupa aia
(command "insert" bname pause 1 1 0)
(command "scale" "l" "" ps 1.2);;;scara 1:2000 nu se prea vede, scalam

;;;OPTIUNEA 2: se poate lua in memorie, si paste dupa aia
;;(command "_cutclip" mselt "")
;;(command "_pasteclip")

;;;OPTIUNEA 3: se face tabelul normal, si pe urma se muta direct ca il face langa punctul nr. 1
;;;(command "move" mselt "" ps)
;;;==================================================================================
(setvar "osmode" osn_old);;;revenim la osnapul dinainte

                            );;;DEFUN

(alert "Lansare cu comanda TAB")