Sub Dynblk()
Dim vklbod As Variant
Dim novyblk As AcadBlockReference
vklbod = ThisDrawing.Utility.GetPoint(, "Vyberte místo pro umístění bloku")
Set novyblk = ThisDrawing.ModelSpace.InsertBlock(vklbod, "Horizontální_formáty.dwg", 1, 1, 1, 0)
If novyblk.IsDynamicBlock Then
    Dim vlastnostinovehoblk As Variant
    Dim viditelnost As AcadDynamicBlockReferenceProperty
    vlastnostinovehoblk = novyblk.GetDynamicBlockProperties
        For j = LBound(vlastnostinovehoblk) To UBound(vlastnostinovehoblk) 'prolezeme všechny vlastnosti
            Select Case vlastnostinovehoblk(j).PropertyName
                 Case "Visibility"
                   vlastnostinovehoblk(j).Value = "A0" 'tady je nastavení příslušné vlastnosti
            End Select
        Next j
End If
novyblk.Update
End Sub

 

a umístěný do adresáře, kde jej může ACAD najít…

Teď nemám k dispozici CAD, takže to nemohu přesně ověřit (ověřím až v lednu), ale mělo by snad zabrat tohle:

 

Sub Dynblk(JmenoBloku as String, JmenoParametru as String, HodnotaParametru as String)
Dim vklbod As Variant
Dim novyblk As AcadBlockReference
vklbod = ThisDrawing.Utility.GetPoint(, "Vyberte místo pro umístění bloku")
Set novyblk = ThisDrawing.ModelSpace.InsertBlock(vklbod, JmenoBloku, 1, 1, 1, 0)
If novyblk.IsDynamicBlock Then
    Dim vlastnostinovehoblk As Variant
    Dim viditelnost As AcadDynamicBlockReferenceProperty
    vlastnostinovehoblk = novyblk.GetDynamicBlockProperties
        For j = LBound(vlastnostinovehoblk) To UBound(vlastnostinovehoblk) 'prolezeme všechny vlastnosti
            Select Case vlastnostinovehoblk(j).PropertyName
                 Case JmenoParametru
                   vlastnostinovehoblk(j).Value = HodnotaParametru
            End Select
        Next j
End If
novyblk.Update
End Sub

 

Volání pro náš příklad by mělo být:

 

-vbarun DynBlk "Horizontální_formáty.dwg","Visibility","A0"

 

ale jak říkám nejsem si zcela jist a ověřím později. Vyzkoušejte. 

Ještě by to chtělo asi ošetřit na vznik chyb při volání příkazu když vlastnost neexistuje, nebo je špatně zadána apod. Později…

 

 

Tedy:

Sub Dynblk()
Dim Vklbod As Variant
Dim Novyblk As AcadBlockReference
Dim Jmeno As String
Dim bodX As Double
Dim bodY As Double
Dim Meritko As Double
Dim HVyska As String
Dim DVyska As String
Dim Otoceni As Double
Jmeno = ThisDrawing.Utility.GetString(False, "Jméno bloku: ")
Vklbod = ThisDrawing.Utility.GetPoint(, "Umístění bloku: ")
Meritko = ThisDrawing.Utility.GetReal("Měřítko bloku: ")
Otoceni = ThisDrawing.Utility.GetReal("Natočení bloku: ")
bodX = ThisDrawing.Utility.GetReal("Bod X:")
bodY = ThisDrawing.Utility.GetReal("Bod Y:")
HVyska = ThisDrawing.Utility.GetString(True, "Horní výška: ")
DVyska = ThisDrawing.Utility.GetString(True, "Dolní výška: ")
Set Novyblk = ThisDrawing.ModelSpace.InsertBlock(Vklbod, Jmeno, Meritko, Meritko, Meritko, Otoceni)
If Novyblk.IsDynamicBlock Then
    Dim VlastnostiNovehoBlk As Variant
    Dim AtributyNovehoBlk As Variant
    Dim J As Integer
    Dim I As Integer
    VlastnostiNovehoBlk = Novyblk.GetDynamicBlockProperties
        For J = LBound(VlastnostiNovehoBlk) To UBound(VlastnostiNovehoBlk) 'prolezeme všechny vlastnosti
            Select Case VlastnostiNovehoBlk(J).PropertyName
                 Case "Poloha X"
                   VlastnostiNovehoBlk(J).Value = bodX
                 Case "Poloha Y"
                   VlastnostiNovehoBlk(J).Value = bodY
            End Select
        Next J
    AtributyNovehoBlk = Novyblk.GetAttributes
        For I = LBound(AtributyNovehoBlk) To UBound(AtributyNovehoBlk) 'prolezeme všechny vlastnosti
            Select Case AtributyNovehoBlk(I).TagString
                 Case "Horní výška"
                   AtributyNovehoBlk(I).TextString = HVyska
                 Case "Dolní výška"
                   AtributyNovehoBlk(I).TextString = DVyska
                 Case "PRVYSKA"
                   AtributyNovehoBlk(I).TextString = HVyska
            End Select
        Next I
       
End If
Novyblk.Update
End Sub

 

Volání z lispu mám vyřešené přes příkaz command:

(command "-vbarun" "Dynblk" dBlok B1 VyskaText uhel dX dY (rtos V1 2 Presnost) (rtos V2 2 Presnost))

Jinak je trochu problém s obecným zadáním typu parametru, páč hodnotu nelze vždy přečíst getstring..(předpokládám že neexistuje něco jako getvariant). Chtělo by to asi vždy vyhodnotit jaký parametr to je (asi česky i anglicky) a dle toho zvolit ctecí funkci..

Každopádně moc děkuju za vzor, velmi mě pomohl. Jinak si myslím, že podobná funkce autocadu celkem chybí. J.

No myslel jsem to asi tak, ze zadávání parametru polohy vyžaduje číslo (getreal), viditelnosti znaky (getstring) nebo překlopení číslo 0/1 (getinteger) a tak... Ale neměl jsem ambici dělat zcela obecnou funkci na měnění parametrů a atributů dyn. bloků - což by bylo jistě jiný kafčo... různé počty různých parametrů a atributů...

 

Jinak Command... vím, že to tak funguje a právě tak toho využívám. Nevím jestli to je úplně "košer", ale přesně jak říkáte - funguje to.

Pokud zmenším měřítko z 1 na 0.1, tak se přestanou zobrazovat grafické symboly např. pro visibility, ale blok zůstane dynamický tj. v properties lze příslušné vlastnosti nastavit, ale opětné zvětšení bloku nevede k zobrazení grafických symbolů - už je nikdy nelze zobrazit. Přitom zmenšení z 1 na např. 0.125 je ok.

Při otevření úplně čistého souboru a pak okamžitě při pokusu vložit dynamický blok sekvencí:

Set Novyblk = ThisDrawing.ModelSpace.InsertBlock(Vklbod, "Horizontální_formáty.dwg", 1#, 1#, 1#, 0)

je vyvolána Run-time chyba -2145386445 (80200033) Filler error. K chybě nedojde, když již ve výkrese nějaké bloky jsou! Pokud takto vkládám obyčejný blok, tak to funguje, dynamický ne!

Jak je vidět, tak dynamické bloky ještě mají své mouchy, nebo se mýlím?