ajutor autolisp

[arttopo]

Multumesc de raspuns, dar mi se pare complicat. Eu vad un program care sa verifice coordonatele de plecare si de sfarsit ale lniei si daca sunt egale cu una din coordonatele altei linii sa o selecteze, si operatia sa se repete pana nu mai gaseste nicio pereche de coordonate egale. Problema e ca nu stiu sa il scriu in lisp sau alt limbaj de programare compatibil cu autocadul.

[arttopo]

S-a rezolvat. Multumesc. :rotfl:

[John Doe]

Pai daca e numai asta, de ce nu folosesti comanda PEDIT? Si selectezi linia ta de plecare, pe urma tot ce prinzi prin jur (cu crossing) si vezi ce iese...

[advex]

S-a rezolvat. Multumesc. :rotfl:

Daca ai gasit o solutie la problema enuntata, ar fi interesant sa o si postezi. Mai invatam si noi cate ceva...

[arttopo]

Cu mare placerea as fi pus autolispul, dar in conditiile in care unii de pe forum cer bani ca sa te ajute prefer sa il tin ptr. mine. Oricum multumesc de raspunsuri.

[John Doe]

Da, unii cer bani. Dar uita-te in sectiunea "Scripturi in LISP, AutoLISP" si ai sa vezi ca nu e chiar asa. Depinde ce consideri tu ajutor sau produs vandabil. Sper sa mai treci pe-aici si poate, in timp, ai sa-ti schimbi parerea actuala.

[AlexGIS]

Cu mare placerea as fi pus autolispul, dar in conditiile in care unii de pe forum cer bani ca sa te ajute prefer sa il tin ptr. mine. Oricum multumesc de raspunsuri.

Ai putea totusi sa faci abstractie de faptul ca unul ti-a cerut bani...

[arttopo]

O sa fac abstractie. Autolisp-ul e facut de cineva de pe un forum de afara, care nu a cerut nimic in schimb. Bafta si sper sa ne ajutam pe viitor " pe bani multi "   Am atasat autolispul, si daca cineva are nevoie de ajutor in domeniul geodeziei cu placere. Poate reusim sa il mai imbunatatim. La un fisier prea mare dureaza cam mult.

(defun c:test ( / el en fl i l1 l2 ls ss so x )
 (if
   (and
     (setq ss (ssget "_X"      '((0 . "LINE" ))))
     (setq en (ssget "_+.:E:S" '((0 . "LINE" ))))
   )
   (progn
     (setq so (ssadd)
           en (entget (ssname en 0))
           l1 (list (cdr (assoc 10 en)) (cdr (assoc 11 en)))
     )
     (repeat (setq i (sslength ss))
       (setq en (ssname ss (setq i (1- i)))
             el (entget en)
             ls (cons (list (cdr (assoc 10 el)) (cdr (assoc 11 el)) en) ls)
       )
     )
     (while
       (progn
         (foreach x ls
           (if
             (vl-some
               (function
                 (lambda ( p )
                   (or (equal (car x) p 1e-8) (equal (cadr x) p 1e-8))
                 )
               )
               l1
             )
             (setq so (ssadd (last x) so) l1 (cons (car x) (cons (cadr x) l1)) fl T)
             (setq l2 (cons x l2))
           )
         )
         fl
       )
       (setq ls l2 l2 nil fl nil)
     )
   )
 )
 (sssetfirst nil so) (princ)
)

Modificat de arttopo (15-03-2012 12:40:22)

[DorinMuresan]

Imi da urmatoarea eroare cand incarc lispul de mai sus:
New Text Document.lsp successfully loaded.
Command: ; error: extra cdrs in dotted pair on input
Poate sa-mi spuna cineva care e solutia?Multumesc

[advex]

Imi da urmatoarea eroare cand incarc lispul de mai sus:
New Text Document.lsp successfully loaded.
Command: ; error: extra cdrs in dotted pair on input
Poate sa-mi spuna cineva care e solutia?Multumesc

Atentie la "smilies" din corpul programului, genereaza multe erori...

Cod [Selectează] Extinde

(defun c:test ( / el en fl i l1 l2 ls ss so x )
  (if
    (and
      (setq ss (ssget "_X"      '((0 . "LINE"))))
      (setq en (ssget "_+.:E:S" '((0 . "LINE"))))
    )
    (progn
      (setq so (ssadd)
            en (entget (ssname en 0))
            l1 (list (cdr (assoc 10 en)) (cdr (assoc 11 en)))
      )
      (repeat (setq i (sslength ss))
        (setq en (ssname ss (setq i (1- i)))
              el (entget en)
              ls (cons (list (cdr (assoc 10 el)) (cdr (assoc 11 el)) en) ls)
        )
      )
      (while
        (progn
          (foreach x ls
            (if
              (vl-some
                (function
                  (lambda ( p )
                    (or (equal (car x) p 1e-8) (equal (cadr x) p 1e-8))
                  )
                )
                l1
              )
              (setq so (ssadd (last x) so) l1 (cons (car x) (cons (cadr x) l1)) fl T)
              (setq l2 (cons x l2))
            )
          )
          fl
        )
        (setq ls l2 l2 nil fl nil)
      )
    )
  ) 
  (sssetfirst nil so) (princ)
)

sursa: http://www.theswamp.org/index.php?topic=38315.0

[DorinMuresan]

                  Da, am observat emoticons alea si adevarul e ca eu le-am inlocuit cu ";)" , acuma observ ca trebuie doar o ")". Dar acuma incarc lispul il lansez cu test si nu se intampla absolut nimic, poate sa fie influentat de versiunea Autocad(2010)?

Modificat de DorinMuresan (16-03-2012 11:29:29)


               

[John Doe]

                  La liniile cu "ssget X" se inlocuise automat de site glilimele+paranteza cu un smilies, si s-a pierdut o paranteza la copy-paste.
Mi-am permis sa pun un spatiu intre glilimele si paranteza, acuma cred ca e bine. Ia inca o data textul cu copy-paste.