kruszynski

Na początek znalazłem jak otworzyć okno do wskazywania pliku. Jak otworzyć okno do wskazania pliku w VBA

Czy dobrze rozumiem, że chodzi o to, żeby po otwarciu rysunku, filtr warstw wyświetlał w managerze warstw tylko te, które nie są z XRefa? Nie ruszamy tego co ma być wyświetlone w modelu, tylko w oknie managera?

Uzupełniona wersja Do pracy z ZWCAD 2022 AddSelected.zelx Dla ZWCAD+ 2015 AddSelected.zel

1. Nie ma gotowego automatu, trzeba poskładać. możemy sprawdzić co jest zaznaczone trzeba z tego odfiltrować bloki z nich można odczytać nazwy. Dim sset As ZcadSelectionSet Dim ssobject As ZcadEntity Dim nazwa As String Set sset = ThisDrawing.PickfirstSelectionSet For Each ssobject In sset nazwa = ssobject.ObjectName If ssobject.ObjectName = "AcDbBlockReference" Then Dim blok As ZcadBlockReference Set block = ssobject Dim punkt As Variant punkt = block.InsertionPoint End If Next ssobject 2. Jest możliwość wybierania we wskazanym punkcie z filtrami określającymi co ma być wybrane np tylko bloki: Dim FilterType(0) As Integer Dim FilterData(0) As Variant FilterType(0) = 0 FilterData(0) = "Insert" Dim ssetObj As ZcadSelectionSet Set ssetObj = ThisDrawing.SelectionSets.Add("1") Dim point(0 To 2) As Double point(0) = 820.4691: point(1) = 954.628: point(2) = 0 ssetObj.SelectAtPoint point, FilterType, FilterData Z tego zbioru trzeba odczytać nazwy. O zaznaczaniu było tutaj 3. Ta konstrukcja jest dla mnie zbyt skomplikowana. W moim pojęciu zaintegrowanie w blok to właśnie jego edycja. Gdzie jest różnica? co ma się dziać? a co nie? dlaczego edycja nie jest odpowiednią operacją? Np zmiana koloru elementów w bloku to właśnie jego edycja. Możemy wszystkim elementom w definicji ustawić kolor na "JakBlok" i wstawionemu blokowi zmienić kolor. To wystarczy?

Chyba najłatwiej tak: Dim attribs As Variant attribs = blkref.GetAttributes ; tu trzeba wybrać odpowiedni atrybut wybierając w pętli po TagString For i = LBound(props) To UBound(props) - 1 Set prop = props(i) If prop.PropertyName = "Rozstaw" Then ; a tu ustawić wartość (TextString) atrybutu End If Next i

A jednak jeszcze trochę głębiej w to wniknąłem i wyszło mi że tam gdzie jest Origin asTxt = CStr(pvalue) Wyrzuca błąd Run-time error '13' : Type mismatch w linijce asTxt = CStr(pvalue) Co w sumie miałby sens, bo w tym przypadku pvalue jest variantem - tablicą trzyelementową. To chyba jest jakiś punkt, A z takimi CStr może sobie nie poradzić. Teraz pytanie co dalej z tym ma się dziać. o jeśli maa to być tylko wyświetlone, to pewnie wystarczy odwołać się do każdego elementu variantu, i poskładać to w jeden tekst. Ale to już pozostawiam, powinno być łatwe.

Wiem że czegoś tu nie rozumiem, ale też jeszcze nie wiem czego. Z eksperymentu wyszło mi, że tablica Dim prop As ZcadDynamicBlockReferenceProperty Zwraca 8 elementów. Te o indeksach 1,3,5,7 mają taką samą nazwę "Origin" Nie wiem dlaczego, i nie wnikam, ale jak zmieniłem pętlę, żeby przechodziła indeksem co 2 For i = LBound(props) To UBound(props) - 1 Step 2 Set prop = props(i) pvalue = prop.Value Dim asTxt As String asTxt = CStr(pvalue) MsgBox (asTxt) Next i To wyświetliło poprawnie i kulturalnie 4 wartości.

Dodałem łączenie elementów jako blok (setq last_mem (entlast) ) ; zapamiętujemy co było ostatnio narysowane, przyda się później ; ..... rysowanie (setq lastent (if (null last_mem) ; (setq lastent (entnext ) ) (entnext ) (entnext last_mem) ) ) (setq Selset (ssadd ) ) ; przygotowujemy zbiór elementów do dodania do bloku (while (not(null lastent ) ) (setq Selset (ssadd lastent Selset) ) ; dodajemy kolejny element do zbioru (setq lastent (entnext lastent)) ; szukamy następnego narysowanego elementu ) (setq nr 1 ) (while (tblsearch "BLOCK" (setq nazwa (strcat "okno" (itoa nr ) ) )) (setq nr (1+ nr) ) ) ; tworzymy blok (definicję) z narysowanych elementów (command "_.-block" nazwa "_non" PU Selset "") ; wstawiamy blok (command "_insert" nazwa PU "" "" "")

Znaki D-18 i D-44 przygotujemy i damy znać. Znaki które wchodzą od dziś będą dostępna przy najbliższej aktualizacji. Może Pan używać już dziś po rozpakowaniu do katalogu c:\Szansa\ZWTraffic\2022\PL\Templates\Vertical traffic signs\ z załącznika. Rozporządzenie z 2 grudnia.zip

Załączone pliki proszę zapisać tutaj: c:\Szansa\ZWTraffic\2022\PL\Templates\Vertical traffic signs\D - Informacyjne\ D-18.dwg D-18_parkomat.dwg

Spotkałem się kiedyś z taką sytuacją, gdzie znaki wstawiały się w nieproporcjonalnej skali. Chyba właśnie x 100. Problem wynikał z tego że w tym projekcie były wcześniej zdefiniowane bloki o nazwach takich jak symbole znaków np "A-1" "B-33" ale w innych jednostkach. Może to pochodziło z jakiejś prywatnej biblioteki znaków innego uczestnika projektu. Rozwiązaniem było zmienić nazwy bloków istniejących znaków. Użyliśmy do tego funkcji NNAZWA(_RENAME). po zmianie nazw starych bloków, znaki wstawiały się poprawnie.

OK, dziękuję za szczegóły, uzupełniłem zgłoszenie do ZWSOFT.

Coś mi tu jeszcze nie pasuje. Kiedy dodałem skrót z makrem '_-view _r A Przerwało polecenie, Kiedy pisałem zgłoszenie do ZWSoft chciałem sprawdzić jeszcze raz jaka dokładnie jest treść makra, i wygląda na to że system z automatu dopisał tam ^C^C Czyli właśnie polecenie do przerywania aktualnej funkcji. Więc usunąłem to ^C^C. Przy następnej próbie już nie przerwało polecenia, ale kiedy użyłem skrót w czasie gdy jakaś funkcja była aktywna, wpisało '_-view _r W miejsce parametrów spodziewanych przez aktualną funkcję. Chciałem też potwierdzić jak to działa w ZWCAD 2015+ w oknie polecenia CUI nie ma miejsca na skróty do kombinacji klawiszy. Gdzie zdefiniował Pan skrót w 2015+ ?

Dziękuję za zgłoszenie, potwierdzam że tak się dzieje i przekazałem temat do ZWSOFT. Dam znać jak czegoś się dowiem

Aktualizacja: Można wybierać katalog gdzie mają być zapisane mapy. Po usunięciu mapy z projektu, usuwa się też z katalogu ZWMS.zip

W załączniku wersja dla ZWCAD 2015+ AddSelected.zel

Dziękuję za uwagi. 6. zmienię przy aktualizacji 7. raczej nie powinno być z tym problemu - dodam przy aktualizacji 8. może to efekt poniedziałku, albo ograniczeń ZWCADa, ale jak dla mnie to zbyt duży krok na teraz. 9. Są spore różnice na poziome nakładek pomiędzy ZWCADem 2018 a 2022. Nie chcąc zbytnio informolsko przynudzać powiem tylko że to się technologicznie nie da.

Mam świeżynkę. można wpisać link do własnego serwera. jeśli nie uda się wstawić mapy i wyświetli komunikat mówiący że nieprawidłowa szerokość i wysokość, można wpisać mniejszą niż ta, którą serwer obiecuje, najczęściej pomaga. odptaszkowywanie już działa, ZWMS.zip

OK, dorobiłem drugą funkcję, która wstawia symbole w załamaniach polilini nową funkcję można uruchomić poleceniem opisz (defun C:zzz ( / symb polilinia *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nC:zzz:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq symb ( SelSet:Entsel "Wybierz strzałkę" (list (cons 0 "INSERT" ))) ) (setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) ) (while (not (null polilinia ) ) (wstawWSrodkuOdcinkow polilinia symb) (setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) ) ) (princ) ) (defun C:opisz ( / symb polilinia *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nC:zzz:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq symb ( SelSet:Entsel "Wybierz symbol" (list (cons 0 "INSERT" ))) ) (setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) ) (while (not (null polilinia ) ) (wstawWZalamaniach polilinia symb) (setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) ) ) (princ) ) (defun wstawWSrodkuOdcinkow ( polilinia symb / ile i *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nwstawWSrodkuOdcinkow:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq ile (vlax-curve-getEndParam polilinia ) ) (setq i 1 ) (repeat (fix ile) (if (not (odcinekJestzbytkrotki polilinia i symb )) (progn (wstawWOdcinku polilinia i symb) ) ) (setq i (1+ i) ) ) ) (defun odcinekJestzbytkrotki ( polilinia i symb / d1 d0 dlugoscodcinka wielkoscsymbolu *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nodcinekJestzbytkrotki:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq d1(vlax-curve-getDistAtParam polilinia i)) (setq d0(vlax-curve-getDistAtParam polilinia (- i 1 ) ) ) (setq dlugoscodcinka (- d1 d0 ) ) (setq wielkoscsymbolu ( BoundingBox:Width ( BoundingBox symb ) ) ) (< dlugoscodcinka (* 3 wielkoscsymbolu) ) ) (defun wstawWOdcinku ( polilinia i symb / midparam px nowysymbol P0 ang *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nwstawWOdcinku:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq midparam (- i 0.5) ) (setq px (vlax-curve-getPointAtParam polilinia midparam ) ) (setq nowysymbol (vlax-invoke-method symb 'Copy ) ) (setq P0 (vlax-get-property nowysymbol 'InsertionPoint ) ) (vlax-invoke-method nowysymbol 'Move P0 (vlax-3d-point px ) ) (setq ang (vlax-curve-getFirstDeriv polilinia midparam) ) (vlax-put-property nowysymbol 'Rotation (angle (list 0 0 0 ) ang ) ) nowysymbol ) (defun wstawWZalamaniach ( polilinia symb / ile i *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nwstawWSrodkuOdcinkow:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq ile (vlax-curve-getEndParam polilinia ) ) (setq i 0 ) (repeat (1+(fix ile) ) (wstawWZalamaniu polilinia i symb) (setq i (1+ i) ) ) ) (defun wstawWZalamaniu ( polilinia i symb / px nowysymbol P0 ang *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nwstawWOdcinku:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq px (vlax-curve-getPointAtParam polilinia i ) ) (setq nowysymbol (vlax-invoke-method symb 'Copy ) ) (setq P0 (vlax-get-property nowysymbol 'InsertionPoint ) ) (vlax-invoke-method nowysymbol 'Move P0 (vlax-3d-point px ) ) (setq ang (vlax-curve-getFirstDeriv polilinia i) ) (vlax-put-property nowysymbol 'Rotation (angle (list 0 0 0 ) ang ) ) nowysymbol ) (defun SelSet:Entsel (tresc filter / OldNoMutt MSel OutVal *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nSelSet:Entsel:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq tresc (strcat "\n" tresc ": ") ) (prompt tresc ) (setq OldNoMutt (getvar 'NOMUTT)) (setvar 'NOMUTT 1) (setq MSel (if (null filter) (vl-catch-all-apply 'ssget (list ":S:E" )) (vl-catch-all-apply 'ssget (list ":S:E" filter )) ) ) (setvar 'NOMUTT OldNoMutt ) (if (vl-catch-all-error-p MSel) (progn (prompt (vl-catch-all-error-message MSel)) ) (progn (if MSel (progn (setq OutVal (vlax-ename->vla-object (ssname MSel 0)) ) )) ) ) OutVal ) (defun BoundingBox (object / width height IP AP P1 P2 MoveVector *error*) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\n BoundingBox : *error*: " ) (princ msg ) (princ "\n") ) ) ) (if (Object:IsErased object ) (*error* "object is erased" )) (setq ans(vl-catch-all-apply 'vlax-invoke-method (list object 'GetBoundingBox 'P1 'P2 ))) (if (vl-catch-all-error-p ans ) (progn (print ( vl-catch-all-error-message ans ) ) ) (progn (setq P1 (List:Factory P1 ) ) (setq P2 (List:Factory P2 ) ) ) ) (list P1 P2 ) ) (defun BoundingBox:Width ( bbox / *error*) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\n BoundingBox:Width : *error*: " ) (princ msg ) (princ "\n") ) ) ) (- (car (cadr bbox) ) (car (car bbox) )) ) (defun List:Factory (InVal / OutVal AsList ; (setq mem InVal ) (setq InVal mem ) *error*) ( defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nList:Factory :*error*: " ) (princ msg ) (princ "\n") ) ) ) (cond ( ( = (type InVal) nil) nil) ( (vl-catch-all-error-p InVal) (progn (princ "Error trapped:" ) (princ InVal ) nil)) ( ( = (type InVal) 'LIST) InVal) ( ( = (type InVal) 'SAFEARRAY) (progn (setq AsList (vl-catch-all-apply 'vlax-safearray->list (list InVal ))) (if (vl-catch-all-error-p AsList) ( progn ( princ (vl-catch-all-error-message AsList ) ) nil ) ( progn AsList ) ) ) ) ( ( = (type InVal) 'VARIANT) (progn (List:Factory (vlax-variant-value InVal) ) ; bo variant value powinien zwrócić safearray ) ) ( t (list InVal ) ) ) ) (defun Object:IsErased ( obj / blockHandle *error*) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\n Object:IsErased: *error*: " ) (princ msg ) (princ "\n") ) ) ) (setq result nil) (if (null obj ) (setq result T) (progn (setq blockHandle (vlax-get-property obj 'handle )) (if (null blockHandle ) (setq result T) (progn (setq entity (handent blockHandle) ) (if (null entity ) (setq result T) (setq result (null (entget entity ) )) ) ) ) ) ) result ) Strzałki.lsp

A tak jeszcze z ciekawości: Jakie to oznaczenie? W jakich projektach to się wykorzystuje ?

Jedni dziobią, inni drapią a ja .... hm. Takie mam: Polecenie do uruchomienia zzz (defun C:zzz ( / symb polilinia *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nC:zzz:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq symb ( SelSet:Entsel "Wybierz strzałkę" (list (cons 0 "INSERT" ))) ) (setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) ) (while (not (null polilinia ) ) (wstawWSrodkuOdcinkow polilinia symb) (setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) ) ) (princ) ) (defun wstawWSrodkuOdcinkow ( polilinia symb / ile i *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nwstawWSrodkuOdcinkow:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq ile (vlax-curve-getEndParam polilinia ) ) (setq i 1 ) (repeat (fix ile) (if (not (odcinekJestzbytkrotki polilinia i symb )) (progn (wstawWOdcinku polilinia i symb) ) ) (setq i (1+ i) ) ) ) (defun odcinekJestzbytkrotki ( polilinia i symb / d1 d0 dlugoscodcinka wielkoscsymbolu *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nodcinekJestzbytkrotki:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq d1(vlax-curve-getDistAtParam polilinia i)) (setq d0(vlax-curve-getDistAtParam polilinia (- i 1 ) ) ) (setq dlugoscodcinka (- d1 d0 ) ) (setq wielkoscsymbolu ( BoundingBox:Width ( BoundingBox symb ) ) ) (< dlugoscodcinka (* 3 wielkoscsymbolu) ) ) (defun wstawWOdcinku ( polilinia i symb / midparam px nowysymbol P0 ang *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nwstawWOdcinku:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq midparam (- i 0.5) ) (setq px (vlax-curve-getPointAtParam polilinia midparam ) ) (setq nowysymbol (vlax-invoke-method symb 'Copy ) ) (setq P0 (vlax-get-property nowysymbol 'InsertionPoint ) ) (vlax-invoke-method nowysymbol 'Move P0 (vlax-3d-point px ) ) (setq ang (vlax-curve-getFirstDeriv polilinia midparam) ) (vlax-put-property nowysymbol 'Rotation (angle (list 0 0 0 ) ang ) ) nowysymbol ) (defun SelSet:Entsel (tresc filter / OldNoMutt MSel OutVal *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nSelSet:Entsel:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq tresc (strcat "\n" tresc ": ") ) (prompt tresc ) (setq OldNoMutt (getvar 'NOMUTT)) (setvar 'NOMUTT 1) (setq MSel (if (null filter) (vl-catch-all-apply 'ssget (list ":S:E" )) (vl-catch-all-apply 'ssget (list ":S:E" filter )) ) ) (setvar 'NOMUTT OldNoMutt ) (if (vl-catch-all-error-p MSel) (progn (prompt (vl-catch-all-error-message MSel)) ) (progn (if MSel (progn (setq OutVal (vlax-ename->vla-object (ssname MSel 0)) ) )) ) ) OutVal ) (defun BoundingBox (object / width height IP AP P1 P2 MoveVector *error*) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\n BoundingBox : *error*: " ) (princ msg ) (princ "\n") ) ) ) (if (Object:IsErased object ) (*error* "object is erased" )) (setq ans(vl-catch-all-apply 'vlax-invoke-method (list object 'GetBoundingBox 'P1 'P2 ))) (if (vl-catch-all-error-p ans ) (progn (print ( vl-catch-all-error-message ans ) ) ) (progn (setq P1 (List:Factory P1 ) ) (setq P2 (List:Factory P2 ) ) ) ) (list P1 P2 ) ) (defun BoundingBox:Width ( bbox / *error*) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\n BoundingBox:Width : *error*: " ) (princ msg ) (princ "\n") ) ) ) (- (car (cadr bbox) ) (car (car bbox) )) ) (defun List:Factory (InVal / OutVal AsList ; (setq mem InVal ) (setq InVal mem ) *error*) ( defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nList:Factory :*error*: " ) (princ msg ) (princ "\n") ) ) ) (cond ( ( = (type InVal) nil) nil) ( (vl-catch-all-error-p InVal) (progn (princ "Error trapped:" ) (princ InVal ) nil)) ( ( = (type InVal) 'LIST) InVal) ( ( = (type InVal) 'SAFEARRAY) (progn (setq AsList (vl-catch-all-apply 'vlax-safearray->list (list InVal ))) (if (vl-catch-all-error-p AsList) ( progn ( princ (vl-catch-all-error-message AsList ) ) nil ) ( progn AsList ) ) ) ) ( ( = (type InVal) 'VARIANT) (progn (List:Factory (vlax-variant-value InVal) ) ; bo variant value powinien zwrócić safearray ) ) ( t (list InVal ) ) ) ) (defun Object:IsErased ( obj / blockHandle *error*) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\n Object:IsErased: *error*: " ) (princ msg ) (princ "\n") ) ) ) (setq result nil) (if (null obj ) (setq result T) (progn (setq blockHandle (vlax-get-property obj 'handle )) (if (null blockHandle ) (setq result T) (progn (setq entity (handent blockHandle) ) (if (null entity ) (setq result T) (setq result (null (entget entity ) )) ) ) ) ) ) result ) Strzałki.lsp

Jeszcze na razie nic pewnego, ale tak po cichu coś tu już grzebię w dokumentacji, może, może coś się uda. To wynika z brzydkich żartów jakie robią serwery. w konfiguracji twierdzą że zakres rozdzielczości szerokości i wysokości ma być w zakresie 1-4096 a tak na prawdę udostępniają czasem mniejsze. Mam już pewien pomysł jak sobie z tym poradzić. Do sprawdzenia. trudno mi teraz powiedzieć co to może być. Może Pani wpisać (wkleić) link do serwera w liście adresów, jak zaznaczone na screenie taki przykład https://mapy.geoportal.gov.pl/wss/service/PZGIK/PRG/WMS/AdministrativeBoundaries Dorobię przy najbliższej aktualizacji

Do chowania przewidziałem krzyżyk w prawym górnym rogu panelu, nie ma to tego oddzielnego polecenia. Polecenie do pokazywania panelu to WMS

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

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