kruszynski

Moderatorzy
  • Posts

    1274
  • Joined

  • Last visited

  • Days Won

    55

kruszynski last won the day on July 2

kruszynski had the most liked content!

4 Followers

About kruszynski

Profile Information

  • Gender
    Not Telling

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

kruszynski's Achievements

  1. Do chowania przewidziałem krzyżyk w prawym górnym rogu panelu, nie ma to tego oddzielnego polecenia. Polecenie do pokazywania panelu to WMS
  2. Trzeba sprawdzić porównać wybrane elementy z każdym elementem w każdej grupie. Dim ent As ZcadEntity For I = 0 To ssetObj.Count Set ent = ssetObj.Item(I) Dim grs As ZcadGroups Dim gr As ZcadGroup Set grs = ThisDrawing.groups For Each gr In grs For J = 0 To gr.Count Dim entwgrupie As ZcadEntity Set entwgrupie = gr.Item(J) If entwgrupie Is ent Then MsgBox "element jest w grupie" Exit Sub End If Next J Next Next I
  3. No tak. Nikt nie mówił że samo się zrobi. 😉 Przykład użycia takiego reaktora tutaj https://www.zwcad.pl/help/lisp-help/vlr-object-reactor.html
  4. Tak na pierwszy rzut oka wygląda na możliwe. Ale jak zwykle diabeł tkwi w szczegółach. Mechanizm reakcji można zrealizować przy użyciu reaktorów. Tylko nigdy nie używałem ich w VBA, nie jestem pewien czy są dostępne. Jeśliby nie były, to można taki reaktor uruchamiać w LISP a on uruchamiałby odpowiednią funkcję w VBA. Co do zasobów to raczej byłbym spokojny, choć oczywiście wszystko zależy od stopnia skomplikowania makra i wielkości pliku. Ale to lepiej sprawdzić w boju niż zakładać że będzie zbyt obciążające. Dla każdego użytkownika taki próg bólu może być w innym miejscu.
  5. Tak właśnie. Te z czerwonej ( parametry dynamiczne bloków ) można odczytać, tylko w głowie mi się kolory poprzestawiały.
  6. Tak na szybko to odczytać właściwości (z niebieskiej ramki) można tak: Public Sub test() Dim ss As ZcadSelectionSet Dim ent As ZcadEntity Dim bname As String Dim props() As ZcadDynamicBlockReferenceProperty Dim pvalue As Variant Dim blkref As ZcadBlockReference With ThisDrawing.SelectionSets While .Count > 0 .Item(0).Delete Wend Set ss = .Add("$DynBlocks$") End With Dim ftype(0 To 1) As Integer Dim fdata(0 To 1) As Variant ftype(0) = 0: ftype(1) = 66 fdata(0) = "INSERT": fdata(1) = 1 ss.SelectOnScreen ftype, fdata If ss.Count = 0 Then MsgBox "Nie wybrano bloku...Kończymy" Exit Sub End If Set blkref = ss.Item(0) Dim i As Integer props = blkref.GetDynamicBlockProperties Dim prop As ZcadDynamicBlockReferenceProperty For i = LBound(props) To UBound(props) Set prop = props(i) pvalue = prop.Value Dim asTxt As String asTxt = CStr(pvalue) MsgBox (asTxt) Next i End Sub Dalej powinno już być łatwo.
  7. Przygotowałem skrypt, który pomoże dzielić model na arkusze: Funkcja do uruchomienia: ww Działanie przedstawiłem na filmiku: Arkusze.zelx
  8. Taka mała aktualizacja. Dorobiłem wstawianie punktów z wysokością odczytaną z serwisu. Polecenie które możemy wpisać by uruchomić funkcję : WstawPunkt GUKiK.lsp
  9. W ZWCAD program działa , dorobiłem tylko odwołanie do funkcji. Całość wygląda tak: (defun URL:Get ( url / *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nURL:Get:*error*: " ) (princ msg ) (princ "\n") ) ) ) (if (setq obj (vlax-create-object "winhttp.winhttprequest.5.1")) (progn (setq rtn (vl-catch-all-apply '(lambda nil (vlax-invoke-method obj 'open "GET" url :vlax-false) (vlax-invoke-method obj 'send) (vlax-get-property obj 'responsebody) ) ) ) (vlax-release-object obj) (if (vl-catch-all-error-p rtn) (prompt (vl-catch-all-error-message rtn)) (vl-list->string (mapcar '(lambda ( x ) (lsh (lsh x 24) -24)) (vlax-safearray->list (vlax-variant-value rtn)) ) ) ) ) ) ) (defun GUKiK:H ( coords / ; (setq coords (list 486617 637928 ) ) *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nPoint:GetHByGUKiK:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq url (strcat "https://services.gugik.gov.pl/nmt/?request=GetHByXY&x=" (rtos (car coords) ) "&y=" (rtos (cadr coords)) "" ) ) (setq H (URL:Get url) ) (atof h) ) A uruchomić można tak (GUKiK:H (list 486617 637928 ) ) albo nawet tak: wskazując punkt w przestrzeni (GUKiK:H (getpoint "\nWskaż punkt: " ) ) Wystarczy plik z załącznika wczytać do ZWCADa poleceniem appload. GUKiK.lsp
  10. Taki skrypt mógłby wyglądać tak: (vl-load-com) (defun c:setByLayer ( / wybrane doc ) (setq wybrane (SelSet:Get "Wybierz elementy do zmiany" nil) ) (SetByLayer wybrane) (vla-regen ( GetThisDrawing ) acallviewports) (princ) ) (defun SetByLayer ( dozmiany / format ) (defun format ( element / ) (setq ans (vl-catch-all-apply 'vlax-put-property (list element 'Color acbylayer ) )) (if (vl-catch-all-error-p ans) (princ (vl-catch-all-error-message ans )) ) ) (cond ((listp dozmiany) (progn (foreach % dozmiany (SetByLayer %) ) )) ((= (vlax-get-property dozmiany 'EntityName ) "AcDbBlockReference") (progn (format dozmiany) (setq elementy (Block:GetItems (vlax-get-property dozmiany 'Name ))) (SetByLayer elementy) )) (t (progn (format dozmiany) )) ) nil ) (defun GetThisDrawing ( / ) (vla-get-activedocument (vlax-get-acad-object) ) ) (defun SelSet:ToList (selset / Wynik ileelementow i *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nSelSet:ToList:*error*: " ) (princ msg ) (princ "\n") ) ) ) (if selset (progn (setq ileelementow(sslength selset) ) (setq i 0 ) (repeat ileelementow (setq Wynik (append Wynik (list (vlax-ename->vla-object(ssname selset i) ) ))) (setq i (1+ i )) ) )) Wynik ) (defun SelSet:FilterByType ( elementy typy / sl i % *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nSelSet:FilterByType:*error*: " ) (princ msg ) (princ "\n") ) ) ) ; (setq elementy (ssget ) ) (setq sl (sslength elementy)) (setq i (1- sl )) (repeat sl (setq % (ssname elementy i)) (if (not (member (cdr(assoc 0 (entget %) )) typy)) (setq elementy(ssdel % elementy)) ) (setq i (1- i) ) ) ) (defun SelSet:Get (tresc typy / selElems elementy Filter % OldNoMutt *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\n SelSet:Get:*error*: " ) (princ msg ) (princ "\n") ) ) ) ;---------------------------------------------------------- ; funkcja sprawdza, czy jakieś elementy zostały zaznaczone, jeśli nie, prosi użytkownika o wskazanie obiektów ; Argumenty: tresc - komunikat wyświetlany w pasku poleceń zachęta do wskazanie obiektów ; Wynik: lista wybranych obiektów jeśli coś zostało wybranie ; nil jeśli nic nie zostało wybrane. ; ---------------------------------------------------------- ; versja 2.0 ; dodane filtrowanie typów ; ---------------------------------------------------------- ; test: ;(sslength (ssget (list (cons 0 "3DSOLID") ))) ; ---------------------------------------------------------- (if typy (progn (if (listp (car typy) ) (setq Filter typy ) (progn (setq Filter (list (cons -4 "<or" ))) (foreach % typy (setq Filter (append Filter (list (cons 0 % ) ))) ) (setq Filter (append Filter (list (cons -4 "or>" ) ))) ) ) )) (setq selElems(ssgetfirst )) (if (car selElems) (progn (setq elementy (SelSet:ToList(SelSet:FilterByType selElems typy))) ) (progn (setq tresc (strcat "\n" tresc ": ") ) (princ tresc ) (setq OldNoMutt (getvar 'NOMUTT)) (setvar 'NOMUTT 1) (setq elementy (if (null Filter) (vl-catch-all-apply 'ssget ) (vl-catch-all-apply 'ssget (list Filter )) ) ) (setvar 'NOMUTT OldNoMutt ) (if (not(vl-catch-all-error-p elementy)) (progn (setq elementy (SelSet:ToList elementy )) ) (progn (setq elementy nil) ) ) ) ) elementy ) (defun Blocks:Get ( BlockName / blocks Def *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nBlocks:Get:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq blocks ( vlax-get-property ( GetThisDrawing ) 'Blocks ) ) (setq Def(vl-catch-all-apply 'vlax-invoke-method ( list blocks 'Item BlockName ) ) ) (if (vl-catch-all-error-p Def) (setq Def nil ) ) Def ) (defun Block:GetItems ( nazwa / definicja ileElementow i element elementy *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nBlock:GetItems:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq definicja (Blocks:Get nazwa ) ) (setq ileElementow ( vlax-get-property definicja 'Count )) (setq i 0) (repeat ileElementow (setq element (vla-item definicja i)) (setq elementy (append elementy (list element ))) (setq i (1+ i)) ) elementy ) (princ) SetByLayer.lsp
  11. Warstwy są tylko jednym z mechanizmów jakiem mamy do dyspozycji. Zastanawiałem się nad tym czy nie byłoby dobrym rozwiązaniem zrobić okienko gdzie moglibyśmy włączać i wyłączać znaki na podstawie jakichś kryteriów. np na podstawie stanu, ale nie tylko. Co jeszcze mogłoby się przydać? Jak z tego korzystać?
  12. Potwierdzam, problem. Poprawię przy aktualizacji.
  13. Takie rozwiązanie wprowadziliśmy jako odpowiedź na zgłoszenia Użytkowników którzy woleli inne odcienie kolorów zwłaszcza niebieskiego i jego odpowiednika w skali szarości, oraz osób, które korzystają z tych samych plików projektów na innych programach. Tam były czasem problemy z wyświetlaniem kolorów. Teraz można je łatwo przypisać na nowo jeśli coś się gdzieś źle wyświetla. Jeśli taki stan zaciemnia sytuację. Może Pan skorzystać z filtrów warstw i wyłączyć wyświetlanie w liście tych, które przeszkadzają.
  14. Dzień dobry. Dziękuję za zgłoszenie. Postaram się wprowadzić to przy kolejnej aktualizacji
  15. W załączniku takie na szybko uklecone w C#. Wczytać można poleceniem netload Nowe polecenie nazywa się: TableRemoveFormatting TableFormatting.zip