kruszynski

2 Sierpnia 2021

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

dmatusz3 · 2 Sierpnia 2021

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

2 Sierpnia 2021

W dniu 16.07.2021 o 19:49, alf napisał:

Funkcjonalność b. użyteczna ale parę uwag:

1. Załadowanie plików wms odbywa się w układzie 92 lub wgs84. A geodezyjne dane są w układzie "2000" - 4 różne zony. Żeby to działało (mam na myśli projektowanie) potrzeba jakieś formy transformacji współrzędnch.. inaczej to podpinanie działa jak przeglądarka..

2. ściąganie z serwera wms danych mi jakoś nie chce działać, tj dla przykładowego pliku w ukł 92 za cholerę nie chce zaladować rastra a dla pliku testowego raz załadowuje a raz nie. Jakieś ograniczenia są w pliku?

wskaż punkt:
wskaż przeciwległy punkt: https://integracja01.gugik.gov.pl/cgi-bin/KrajowaIntegracjaEwidencjiGruntow?SERVICE=WMS&REQUEST=GetMap&VERSION=1.3.0&FORMAT=image/png&WIDTH=4097&HEIGHT=2544&LAYERS=powiaty,powiaty_obreby,powiaty_uzytki,ekw,pesel,regon,zsin,geoportal,obreby,StanUslugPowiatowych,dzialki,numery_dzialek,budynki,uzytki,kontury&CRS=EPSG:2180&BBOX=217566.090597178,512942.042513065,218084.773400158,513777.323910072&STYLES=default,default,default,default,default,default,default,default,default,default,default,default
Nie udało się pobrać mapy !
msWMSLoadGetMapParams(): WMS server error. Image size out of range, WIDTH and HEIGHT must be between 1 and 4096 pixels.

3. próbowałam pobrać wms dla gesut.. serwis powinien działać, bo sprawdziłam na innym programie, tu nie chce się w ogóle załadować (choćby same obszary właczone do gesut)

Wskaż obrys: https://integracja.gugik.gov.pl/cgi-bin/KrajowaIntegracjaUzbrojeniaTerenu?SERVICE=WMS&REQUEST=GetMap&VERSION=1.3.0&FORMAT=image/png&WIDTH=4088&HEIGHT=2796&LAYERS=gesut,kgesut&CRS=EPSG:2180&BBOX=219512.344571675,506492.021231322,219636.591525453,506673.646622279&STYLES=default,defaultSystem.NotImplementedException: Metoda lub operacja nie jest zaimplementowana.
w ZWLibrary.Raster.Insert(Point2d px, Vector2d size, Transaction tr)
w ZWMS.WMS_Map_cmd.insert(String rasterPath)
4. Czy można i ew jak wprowadzać inne, własne linki wms? Są np mapy orto i cała masa map tematycznych..

5. Odptaszkowanie nie dizała. Można "za-ptaszkować" i właczają się wszystkie warstwy ale "od-ptaszkowac" wszystkich na raz się nie da

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

15 Lipca 2021

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

WMS

dmatusz3 · 2 Lipca 2021

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

1 Lipca 2021

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

1 Lipca 2021

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.

1 Lipca 2021

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

1 Lipca 2021

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.

s1016 · 18 Czerwca 2021

Przygotowałem skrypt, który pomoże dzielić model na arkusze:

Funkcja do uruchomienia:

ww

Działanie przedstawiłem na filmiku:

Arkusze.zelx

10 Czerwca 2021

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

dmatusz3 · 10 Czerwca 2021

W dniu 9.06.2021 o 09:40, Adam_x napisał:

Pytanie czy ma ktoś jakiś pomysł i czy jest możliwe by taki program działał w LISP(ZWCAD) ?

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

dmatusz3 · 8 Czerwca 2021

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

17 Maja 2021

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

5 Maja 2021

Potwierdzam, problem. Poprawię przy aktualizacji.

28 Kwietnia 2021

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

28 Kwietnia 2021

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

11 Marca 2021

W załączniku takie na szybko uklecone w C#.

Wczytać można poleceniem netload

Nowe polecenie nazywa się: TableRemoveFormatting

TableFormatting.zip

26 Lutego 2021

Trudo powidzieć co powoduje problem w starej wersji.

Sprawdziłem też na aktualnej 2021 i tutaj działa bez problemu.

10 Lutego 2021

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?

8 Lutego 2021

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

8 Lutego 2021

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.

8 Lutego 2021

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

17 Listopada 2020

Szybkie pytanko szybka odpowiedź:

(command "_layer" "_off" "zbrojenie_linie" "")

16 Listopada 2020

56 minut temu, piotrb napisał:

pytanie 2: gdzie i jak mogę sprawdzić parametry linii wymiarowej (np 'Measurement) itd. Chodzi mi o to, żeby poznać nazwy parameterów danych obiektów.

Jeśli dobrze rozumiem pytanie to będzie to

(vlax-dump-object dim t )

gdzie

(setq dim (vlax-ename->vla-object (car(entsel "Wybierz "))))

Zaloguj się

Profile

Forum

Blogi

Kalendarz

Galeria

Odpowiedzi opublikowane przez kruszynski