kruszynski

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 "))))

Tą linię (setq dim (vlax-ename->vla-object (car(entsel "Wybierz wymiar")))) Możesz rozbić na (setq selected(entsel "Wybierz wymiar")) (setq dim (vlax-ename->vla-object (car selected ) ) ) I sprawdź co zwraca (setq selected (entsel "Wybierz wymiar"))

W pasku poleceń wklej kolej linie i napisz w której jest problem.

Nie wiem. Nie mam i nie znam Arcadi. Ale tak na czuja to skoro pozwala na wskazanie wymiaru to wygląda na to że LISPy obsługuje. Może nie ma albo nie ładuje z automatu środowiska Visual LISP, spróbuj na początku skryptu dodać linię (vl-load-com) A jak nie łyknie to spróbujemy jeszcze czegoś innego.

Tak na szybko to mogłoby to być takie coś: (setq R (getdist "podaj rozstaw")) (setq dim (vlax-ename->vla-object (car(entsel "Wybierz wymiar")))) (setq A (vlax-get-property dim 'Measurement) ) (setq X (/ A R)) (vlax-put-property dim 'TextOverride (strcat "#8 co " (rtos X) " cm")) Nie ma jeszcze zaokrąglenia. Nie wiem czy zadziała w Arcadi. w ZWCAD działa.

W załączniku aktualizacja pozwalająca wskazywać wiele elementów Szyk.lsp

Taki skrypt mógłby wyglądać np tak: (defun C:SzykManualny ( / element odleglosc bazowy kierunek Koniec licznik kopiuj *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nC:SzykManualny:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq Koniec "" licznik 1 ) (defun kopiuj ( / v1 *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nkopiuj:*error*: " ) (princ msg ) (princ "\n") ) ) ) ( setq v1 ( Vector:Normalize ( Vector: kierunek bazowy ) ) ) ( setq v ( Vector:XScalar v1 (* odleglosc licznik ) ) ) ( setq clone (vlax-invoke-method element 'Copy) ) ( setq px (Vector+ bazowy v )) (vlax-invoke-method clone 'Move (vlax-3d-point bazowy) (vlax-3d-point px) ) (setq licznik (1+ licznik)) ) (setq element (SelSet:Entsel "Wskaż element" nil)) (if (null element) (*error* nil) ) (setq odleglosc (ZWCAD:GetDist "Podaj odległość" poprzedniaOdleglosc)) (if (null odleglosc) (*error* nil) ) (setq bazowy (ZWCAD:Getpoint "Wskaż punkt bazowy" nil nil ) ) (if (null bazowy) (*error* nil) ) (setq kierunek (ZWCAD:Getpoint "Wskaż kierunek" bazowy nil ) ) (if (null kierunek) (*error* nil) ) (while (equal Koniec "") ( kopiuj ) (setq Koniec ( ZWCAD:GetString "Czy wstawić kolejny" "" ) ) ) (setq poprzedniaOdleglosc odleglosc) (princ) ) (defun Vector: ( A B / *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nVector::*error*: " ) (princ msg ) (princ "\n") ) ) ) (list (- (car A) (car B ) ) (- (cadr A) (cadr B ) ) (- (caddr A) (caddr B ) ) ) ) (defun Vector:Length (vec / s *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nVector:Length:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq s (+ (* (car vec) (car vec) ) (* (cadr vec) (cadr vec) ) (* (caddr vec) (caddr vec) ))) (if (< s 0.0000000000001 ) 0.0 (sqrt s )) ) (defun Vector:Normalize (v / len *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nVector:Normalize:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq len (Vector:Length v) ) (if (< len 0.00000001) (list 0.0 0.0 0.0 ) (progn (list (/ (car v ) len) (/ (cadr v ) len) (/ (caddr v ) len) ) ) ) ) (defun Vector:XScalar (v s / *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nVector:XScalar :*error*: " ) (princ msg ) (princ "\n") ) ) ) (mapcar '(lambda (x) (* x s) ) v ) ) (defun Vector+ (A B / *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\n Vector+ : *error*: " ) (princ msg ) (princ "\n") ) ) ) (if (null A) (setq A (list 0.0 0.0 0.0 ) )) (if (null B) (setq B (list 0.0 0.0 0.0 ) )) (list (+ (car A ) (car B) ) (+ (cadr A ) (cadr B) ) (+ (caddr A ) (caddr B ) ) ) ) (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 ZWCAD:GetDist (tresc domyslny / Wynik trescformat liczba *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nZWCAD:GetDist:*error*: " ) (princ msg ) (princ "\n") ) ) ) (if domyslny (if (numberp domyslny) (setq tresc (strcat tresc "<" (rtos domyslny 2 4) ">") ))) (setq tresc (strcat "\n" tresc ": ")) (setq liczba(vl-catch-all-apply 'getdist (list tresc ))) (if (vl-catch-all-error-p liczba) (progn (prompt (vl-catch-all-error-message liczba)) (setq Wynik nil ) ) (progn (if (null liczba) (setq Wynik domyslny ) (setq Wynik liczba) ) ) ) Wynik ) (defun ZWCAD:Getpoint (tresc P0 domyslny / SelPt Wynik *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nZWCAD:Getpoint:*error*: " ) (princ msg ) (princ "\n") ) ) ) ;(ZWCAD:Getpoint tresc P0 domyslny ) (setq tresc (strcat "\n" tresc ": ")) (if (not(null P0)) (setq SelPt(vl-catch-all-apply 'getpoint (list P0 tresc ))) (setq SelPt(vl-catch-all-apply 'getpoint (list tresc ))) ) (if (vl-catch-all-error-p SelPt) (progn (prompt (vl-catch-all-error-message SelPt)) (setq Wynik nil ) ) (progn (if (null SelPt) (setq Wynik domyslny ) (setq Wynik SelPt) ) ) ) Wynik ) (defun ZWCAD:GetString (tresc domyslny / *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nZWCAD:GetString:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq tresc (strcat "\n" tresc ": ")) (String:Get tresc domyslny) ) (defun String:Get (komunikat defVal / Wynik tekst *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nString:Get:*error*: " ) (princ msg ) (princ "\n") ) ) ) ; (setq komunikat "podaj tekst" ) ; (setq defVal "SLU" ) (if defVal (if (not(= defVal "")) (setq komunikat (strcat komunikat "<" defVal ">:" ) )) ) (setq tekst(vl-catch-all-apply 'getstring (list komunikat ))) (if (vl-catch-all-error-p tekst) (progn (prompt (vl-catch-all-error-message tekst)) (setq Wynik nil ) ) (progn (if (null tekst) (setq Wynik defVal ) (if (= tekst "") (setq Wynik defVal ) (if (= tekst ".") (setq Wynik "") (setq Wynik tekst) ) ) ) ) ) Wynik ) Szyk.lsp