Lisp - zlecenie napisania programu


Recommended Posts

Dzień dobry.

Czy jest możliwość zlecenia napisania odpłatnie (o jakich kwotach jest mowa?) napisania lispa w jakiś sposób automatyzującego część mojej pracy. Już piszę o co mi chodzi. Generalnie robię projekty oznakowania robót drogowych. Dostaję od geodety plik CAD w formacie DXF. Jest to plik z zasobów geodezyjnych danego obszaru terenu. Około 200 – 220 warstw. Zawsze tak samo nazwane warstwy. Oczywiście może się zdarzyć że dostanę jakiś wyjątkowo ubogi w infrastrukturę obszar i będzie na nim tylko np. 180 warstw.

Do moich projektów powiedzmy że 100 z tych warstw od razu wyłączam (może nawet więcej), potem gdy już je wyłączę, to to co zostało zaznaczam i zmieniam kolor tego co zostało na ciemny szary, no i następnie zaczyna się zabawa poleceniem Quick Select zmieniam „parametry” różnych warstw. I tak na przykład warstwa o nazwie „219-Linia granicy” wg jakiś tam moich zasad i upodobań ma być zielona, przerywana, grub. 0,18, następnie warstwa „chodnik (powierzchnia)” ma być koloru 100,33,101, dalej warstwa „jezdnia (powierzchnia)” ma być czerwona, grubości 0,3 i linia ciągła, warstwy związane z płotami ogrodzeniami maja być brązowe jako FANCELINE1, warstwy związane z zielenią mają być ciemno zielone, każdy tekst o wysokości 0,75 ma być czarny i wys. 1,25 itd. itd….. Zajmuje mi to zawsze dużo czasu, poza tym często okazuje się że jak zwykle o czymś zapomniałem albo za dużo przypadkiem wyłączyłem itp.

Mam taka listę rzeczy które muszę za każdym razem robić aby przystąpić do właściwej pracy, uzależnione jest to od wielkości na jakiej zamierzam drukować dany projekt A3 lub A4 (1:500 czy 1:1000).

No właśnie….. Czy takie coś idzie zautomatyzować…….. I za ile :)

Pozdrawiam

Link to comment
Share on other sites

Wrzuć "kawałek" rysunku z tymi warstwami jakie są i dla kilku tych warstw napisz jakie chcesz mieć właściwości. To pozwoli coś "zlispować" na szybko jako przykład. Tych parę linijek kodu można napisać w końcu za free. Właśnie jako przykład. Jeszcze jak potwierdzisz że dzięki temu zszedłeś z 2 godzin pracy na 20 sekund... 😉

Link to comment
Share on other sites

Po pierwsze dziękuję za odzew. :)

Zacząłem przygotowywać jakiś plik terenu (wszystko jest widoczne np. w geoportalu więc chyba nic tajnego nie ma:)

"oryginał_02" - tak wyglada plik od geodety

"oryginał_03-warstwy_OFF" - tutaj (nie sprawdzałem super dokładnie, ale najprawdopodobniej wszystkie nieużyteczne dla mnie warstwy wyłączyłem. Oczywiście na innych plikach mogą wystąpić inne nazwy warstw, których tu nie było (np. może tu być okolica gdzie nie będzie lasu iglastego więc nie będzie warstw "las iglasty (powierzchnia)" a gdzie indziej takie coś wystapi)

"oryginał_04" - wynik końcowy - przygotowany do pracy

No i najbardziej czasochłonny etap (zmiany poprzez Quick Select)

1. warstwa "jezdnia (powierzchnia)" - czerwony RED, grubość 0,3, linia ciągła "bylayer" (albo Conrinous)

2. warstwa "krawężnik (linia) - czerwony RED, grubość 0,3, linia ciągła "bylayer" (albo Conrinous)

3. warstwa "plac (powierzchnia) - zmiana koloru na buraczkowy 147,39,143

4. warstwa "chodnik (powierzchnia) - zmiana koloru na buraczkowy 147,39,143

5. warstwa "219-linia granicy" - zielony GREEN - linia przerywana 218-500

6. warstwy: brama linia; brama linia (symbol); furtka linia; furtka linia (symbol) - kolor brązowy 15

7.  warstwa "ogrodzenie trwałe (linia) - - kolor 15, grubość linii bylayer, rodzaj linii fenceline1

8. warstwa "woda stojąca (powierzchnia)" oraz "woda stojąca (powierzchnia)-Atr17" - zmiernić na kolor jasny nieb (CYAN)

.

.

:) :) :)

21. warstwa "211- Nr działki" - zmienić kolor na zielony GREEN oraz wysokosć z 1,25 na 1,30

22. warstwy "238-Punkt adresowy budynku" oraz "238-Punkt adresowy" - zmienić na kolor czarny

23. warstwa "994-Nazwa ulicy" - zmienić na kolor czarny, grubość 0,3, wysokość 1,5

24. no i powiedzmy ostatnie które może się różni od powyższych to QUICK SELECT-object typu TEXT->Height Value 0,75 zmienić na 1,25 i na kolor czarny

Nie pisałem więcej , może to jest tak że poprzez analogię udało by mi się samemu dopisać to co bym chciał. Nie wiem też, czy można wpisać np. wyłączenie nieistniejących warstw (akurat w danym pliku) i nie spowodowałoby to wywalenia się dalszych poleceń lispa, wtedy mógłbym regularnie dopisywać nawet rzadko występujące warstwy..... Nie wiem czy napisałem to zrozumiale :).

Niektóre też pliki są dość duże przynajmniej jak na mojego kompa i wykonanie danego polecenia, albo zaznaczenie danej warstwy (a potem jej zmiana) chwilę trwa i LISP jakby musi czekać :)

 

oryginał_02.dwg oryginał_03-warstwy_OFF.dwg oryginał_04.dwg

Link to comment
Share on other sites

Chyba jestem cieńszy w uszach niż myślałem... 😞

 

	(defun C:MODYFIKACJA_WARSTW ( / POM n ENT_POM BASE )

		(setvar "cmdecho" 0 )
		(setq BASE (list
			
			;W tym miejscu uzupełniasz sobie listę interesujących Cię wartstw wg podanego klucza
			;NAZWA WARSTWY  || 1=widoczny / -1=wygaszony  || KOLOR  || STYL LINII 
			'(  "209-Opis konturu klasyfikacyjnego" 1 	55	"sm05_500")
			'( 	"238-Punkt adresowy budynku" 1	161	"sm05_500")
			'( 	"219-Linia granicy" 1 	1	"sm05_500")

		));setq		


		(foreach EL BASE
			(if (/= nil (tblobjname "layer" (nth 0 EL )))
				(progn
				
					(setq POM (tblobjname "layer" (nth 0 EL)))
					(setq ENT_POM (entget POM ))
					(setq ENT_POM (subst (cons 62 (* (nth 1 EL )(nth 2 EL )))(assoc 62 ENT_POM ) ENT_POM ))
					(setq ENT_POM (subst (cons 6 (nth 3 EL ))(assoc 6 ENT_POM ) ENT_POM ))
					(entmod ENT_POM )
				);progn
				(progn
					(princ (strcat "\n...barak warstwy: <<<" 	(nth 0 EL )  ">>> na rysunku..."))
				);progn
			);if
		);foreach
		
		(princ "\n<<< warstwy zmodyfikowane! >>>")
		(princ)
	);defun	
		
	(defun C:MODYFIKACJA_OBIEKTOW ( / KOLOR WYSOKOSC WYB POM ENT_POM n )
		(setvar "cmdecho" 0 )

		(setq 
			KOLOR 		12    	 			;<<<<<<<<<<<<<<< TUTAJ WPISUJESZ NR KOLORU
			WYSOKOSC 	2.40    	 		;<<<<<<<<<<<<<<< TUTAJ WPISUJESZ WYSOKOSC TEXTU
		);setq 
		
		(setq WYB (ssget "x"  '((-4 . "<AND")(0 . "TEXT")(8 . "211-Nr dzia*ki")(-4 . "AND>")))) ;<<<<<<< TUTAJ W NAWIASIE (8 . "xxx") WSTAWIASZ NAZWE WARSTWY
		
		(if (/= nil WYB) 
			(progn
				(setq n 0 )
				(repeat (sslength WYB )
				
					(setq POM (ssname WYB n ))
					(setq ENT_POM (entget POM))

					(setq ENT_POM (subst (cons 40 WYSOKOSC )(assoc 40 ENT_POM ) ENT_POM ))
					
					(if (assoc 62 ENT_POM)
						(progn
							(setq ENT_POM (subst (cons 62 KOLOR )(assoc 62 ENT_POM ) ENT_POM ))
						);progn
						(progn
							(setq ENT_POM (append '(cons 62 KOLOR ) ENT_POM ))
						);progn
					);if

					(entmod ENT_POM )

					(setq n (1+ n ))
				);repeat
				(princ "\n<<< obiekty zmodyfikowane! >>>")
			);progn
			(progn
				(alert "\n<<< nie znalazłem tekstow o podanych kryteriach! >>>")
			);progn
		);if
		(princ)
	);defun	

Popełniłem coś takiego - proszę o krytykę tutejszych Gooru. Działa, ale nie sądzę że jest to najwyżej punktowana odpowiedź
i
trzeba by się było nad tym jeszcze chwilę popastwić.
a) nie potrafię sobie poradzić z polskimi znakami w nazwach warstw

b) nie wiem jak się zmienia kolory "truecolor")

 

Link to comment
Share on other sites

Z mojej strony takie coś:

; -------------------------------------------------------------------------------------------- ;
; by kojacek 2022
; -------------------------------------------------------------------------------------------- ;
(defun C:MOD_WAR (/ d)
  (if
    (setq d (cd:SYS_ReadFile nil (findfile "warstwy.dat")))
    (if
      (setq d
        (vl-remove-if '(lambda (%)(/= (substr % 1 1) "*")) d)
      )
      (progn
        (cd:SYS_UndoBegin)
        (foreach % d (LayChProp %))
        (cd:SYS_UndoEnd)
      )
    )
  )
  (princ)
)
; -------------------------------------------------------------------------------------------- ;
(defun LayChProp (Data / d s c v p g x y cl :color :tcolor :lweight)
  (defun :lweight (/ %1 %2 %3)
    (vl-remove-if 'minusp
      (if
        (setq %1
          (vl-sort
            (vl-remove-if-not
             '(lambda (%2)(wcmatch %2 "ACLNWT*"))
              (atoms-family 1)
            )'<
          )
        )
        (mapcar
          '(lambda (%3) (eval (read %3))) %1
        )
      )
    )
  )
  (defun :tcolor ()
    (vla-getinterfaceobject
      (vlax-get-acad-object)
      (strcat
        "AutoCAD.AcCmColor."
        (substr (getvar "ACADVER") 1 2)
      )
    )
  )
  (defun :color (i m / r)
    (if
      (<= (strlen i) 3)
      (progn
        (setq r (abs (atoi i)))
        (if m
          (if (and (>= r 0)(<= r 256)) r)
          (if (and (>= r 1)(<= r 255)) r)
        )
      )
      (progn
        (setq r (cd:STR_Parse i "," t))
        (if
          (and (listp r)(= 3 (length r)))
          (mapcar 'atoi r)
        )
      )
    )
  )
  (setq d (cd:STR_Parse Data ";" t)
        l (substr (car d) 2)
  )
  (if
    (= 5 (length d))
    (if
      (tblobjname "LAYER" l)
      (progn
        (setq s (cadr d)                                        ; lay-on-off
              v (vlax-ename->vla-object (tblobjname "LAYER" l)) ; lay-vlaxobj
              c (:color (caddr d) nil)                          ; lay-color
              p (cadddr d)                                      ; lay-ltype
              g (atoi (car (cddddr d)))                         ; lay-lwght
              x (ssget "_x"
                  (list
                    (cons 8 l)
                    (cons 410 (getvar "CTAB"))
                  )
                )
        )
        (if
          (member s '("0" "1"))
          (if (zerop (read s))
            (LayOnOff l)
          )
        )
        (if c
          (if
            (= (type c) 'INT)
            (vla-put-Color v c)
            (progn
              (setq cl (:tcolor))
              (vla-SetRGB cl (car c)(cadr c)(caddr c))
              (vla-put-TrueColor v cl)
            )
          )
        )
        (if
          (tblobjname "LTYPE" p)
          (vla-put-Linetype v p)
        )
        (if
          (and g (member g (:lweight)))
          (vla-put-LineWeight v g)
        )
        (if x
          (progn
            (setq x (cd:SSX_Convert x 1))
            (foreach % x
              (vla-put-Color % 256)
              (vla-put-LineType % "ByLayer") 
              (vla-put-LineWeight % -1)
            )       
          )
        )
        
      )
    )
  )
)
; -------------------------------------------------------------------------------------------- ;
(defun LayOnOff (Lay / e d)
  (if
    (setq e (tblobjname "LAYER" Lay))
    (progn
      (setq d (entget e))
      (setq d
        (subst
          (cons 62
            (* -1 (cdr (assoc 62 d)))
          )
          (assoc 62 d)
        d)
      )
      (entmod d)
    )
  )
)
; -------------------------------------------------------------------------------------------- ;
(princ)

Potrzebne będą:

1) Załadowany plik CADPL-Pack-v1.lsp (tutaj info: https://kojacek.wordpress.com/2015/11/04/cadpl-pack/)

2) plik o nazwie warstwy.dat i poniższej strukturze:

;;;*name,status,layercolor,layelinetype,layerlineweight

*jezdnia (powierzchnia);1;7;Continous;30
*krawężnik (linia);1;1;Continous;30
*plac (powierzchnia);1;147,39,143;%;%
*chodnik (powierzchnia);1;147,39,143;%;%
*219-linia granicy;1;3;218-500;%;%
*211- Nr działki;1;3;%;%
*238-Punkt adresowy budynku;1;7;%;%
*238-Punkt adresowy;1;7;%;%
*994-Nazwa ulicy;1;27;%;30

Działa to wszystko tak: 

- wywołujemy polecenie MOD_WAR (trzeba załadowac wczesniej kod i Pack-a)

- jezeli zostanie znaleziony plik tekstowy warswtwy,dat, to dla danych z kazdej linii wykonywane sa zmiany dla warstw.

Skladnia pliku jest prosta:

- brane sa pod uwage tylko linie rozpoczynajace sie od * (gwiazdki)

- po niej nastepuje nazwa warstwy,

- separatorami sa znaki "srednika" ;

- po warstwie wystepuja koleno dane: stan warstwy (jezeli jest to 0 warstwa jest ukrywana) dopuszczalne wartosci to 0 i 1

- potem jest kolor warstwy - liczba (od 1 do 255) lub RGB formatu rrr,ggg,bbb (separatorem jest przecinek)

- po kolejnym sredniku jest nazwa rodzaju linii, jezeli zostanie znaleziony w rysunku zostanie przypisany do warstwy

- na koncu jest szerokosc linii. Tylko dopuszczalne szerokosci, (zobacz: https://kojacek.wordpress.com/2015/11/26/szerokosc-linii/)

ogólnie dla wartosci dla których nic nie zmieniamy wstawiamy znak procent (%). program kontroluje poprawnosc dla czesci danych, wtedy je pomija. 

Plik dat trzeba sobie rozbudowac o kolejne wpisy,

 

Link to comment
Share on other sites

Ja pier*$%#$%, nie wiem co napisać, nie wiem co powiedzieć, szczęka opadła...... :) :) :)

Stworzyłem pliczek wg zaleceń kolegi KOJACEK. Jakoś udało się to nawet wkleić w odpowiednie miejsce i wczytać. :)

Wszystko naprawdę ładnie poszło mniej więcej tak jak to sobie wymyśliłem, oczywiście jeszcze trochę czasu zajmie zanim pliczek "warstwy.dat" będzie kompletny pod moje potrzeby (no albo przynajmniej prawie kompletny:).

Jedynie o czym muszę pamiętać to zanim uruchomię polecenie mod_war muszę wczytać linie FENCELINE1 oraz po wszystkim muszę zmienić wielkość tekstu z 0.75 na 1.25

Dziękuję SWAZY również za zainteresowanie, skorzystałem co prawda z kolegi propozycji, ale pierwsze przemyślenia Ty zapoczątkowałeś......

Jeszcze raz serdecznie dziękuję

Jak mogę się Wam odwdzięczyć? :) Piwko / whisky? :)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
 Share