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?

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.

 

Trochu to upřesněte. Který parametr to dělá a při jakých hodnotách? (Příklad?)

 

Jinak ten Command je v podstatě "simulace" psaní v příkazovém řádku tj. to co musí normálně napsat uživatel - je to korektní postup, ale nevím, zda se to dá považovat za předání parametrů funkci (když funkce nebude mít implementováno čtení tj. vyžadování parametrů, tak je nenačte).

 

Opačně při "předání" parametrů z VBA do Lispu obdobně lze použít SendCommand

 

Důležité je, že to takhle alespoň funguje a tedy lze s jistými omezeními kombinovat oba programovací přístupy.

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.

Zde je upravené makro, které mění požadované vlastnosti (není ošetřeno na chyby v zadání):

 

Sub Dynblk()
Dim vklbod As Variant
Dim novyblk As AcadBlockReference
JmenoBloku = ThisDrawing.Utility.GetString(False, "Zadejte jméno vkládaného bloku: ")
JmenoParametru = ThisDrawing.Utility.GetString(False, "Zadejte jméno měněného parametru: ")
HodnotaParametru = ThisDrawing.Utility.GetString(False, "Zadejte hodnotu parametru: ")
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

 

Po jeho spuštění z příkazového řádku -vbarun DynBlk

se postupně dotáže na hodnoty. Zadání najednou není zatím možné.

Spustit z Lispu lze např.:

 

(defun c:TVBA ()
   (vl-vbarun "DynBlk")
)

 

ale předání parametrů mezi Lispem a VBA není možné (alespoň nevím jak). Příkaz vl-vbarun umožní spustit pouze makro bez parametrů a ani lisp neumožňuje definovat fukce spustitelné z příkazového řádku s parametry tj. Defun c:DynBlk (JmBloku JmParametru HodnotaParametru)

 

Takže buď vše bude napsáno ve VBA a nebo v Lispu. Asi je třeba se rozhodnout hned na začátku.

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…

 

 

 

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