kruszynski

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

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.

Tak właśnie. Te z czerwonej ( parametry dynamiczne bloków ) można odczytać, tylko w głowie mi się kolory poprzestawiały.

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.

Przygotowałem skrypt, który pomoże dzielić model na arkusze: Funkcja do uruchomienia: ww Działanie przedstawiłem na filmiku: Arkusze.zelx

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

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

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

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ć?

Potwierdzam, problem. Poprawię przy aktualizacji.

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ą.

Dzień dobry. Dziękuję za zgłoszenie. Postaram się wprowadzić to przy kolejnej aktualizacji

W załączniku takie na szybko uklecone w C#. Wczytać można poleceniem netload Nowe polecenie nazywa się: TableRemoveFormatting TableFormatting.zip

Trudo powidzieć co powoduje problem w starej wersji. Sprawdziłem też na aktualnej 2021 i tutaj działa bez problemu.

Też się z tym kiedyś spotkałem, ale nie umiem wywołać na życzenie. Przypuszczałem że to związane z moimi programistycznymi działaniami. A tu okazuje się że temat jest szerszy. Czy potrafi Pan doprowadzić to takiego zachowania świadomie? Co musiałbym zrobić żeby u mnie też tak się stało?

Jaki vernum? i ile obiektów powinno zaznaczyć tak mniej-więcej?

Chwila bo czegoś nie rozumiem. Może mamy coś inaczej. U mnie okienko właściwości jest otwarte cały czas. Po uruchomieniu takiej funkcji we właściwościach pojawiają mi sie zaznaczone bloki z możliwością zmian.

Wybitnie brzydki i nieintuicyjny fragment kodu. Tak przyjmuję wszelką krytykę z pokorą. Ale zaznacza wszystkie bloki w tym przypadku o nazwie "A-1". Public Sub Test() Dim ssh As ZcadSelectionSet Dim Ftyp(1) As Integer Dim Fdat(1) As Variant Dim BlockName As String BlockName = "A-1" Dim F1, F2 As Variant Ftyp(0) = 0: Fdat(0) = "Insert" Ftyp(1) = 2: Fdat(1) = BlockName Set sstest = ThisDrawing.SelectionSets.Add("sstest") F1 = Ftyp F2 = Fdat sstest.Select zcSelectionSetAll, , , Ftyp, Fdat Dim GroupName As String GroupName = "sstest" Dim group As ZcadGroup Set group = ThisDrawing.Groups.Add(GroupName) For Each Item In sstest group.AppendItems (Item) Next sstest.Delete ThisDrawing.SendCommand ("_SELECT" + vbCr + "G" + vbCr + GroupName + vbCr + vbCr) group.Delete End Sub Pozostaje odfiltrować bloki po atrybucie. Iteracyjnie, w pętli trzeba sprawdzić wartość każdego atrybutu w każdym zaznazconym bloku. Który atrybut jest pierwszy? ten który został wcześniej wstawiony do rysunku? a może ten najwyżej? Raczej posługiwałbym się tu nazwą atrybutu (TagString) niż tym który jest pierwszy. ale... to już temat na inna historię.

Szybkie pytanko szybka odpowiedź: (command "_layer" "_off" "zbrojenie_linie" "")

Jeśli dobrze rozumiem pytanie to będzie to (vlax-dump-object dim t ) gdzie (setq dim (vlax-ename->vla-object (car(entsel "Wybierz "))))