Zobrazit plnou verzi příspěvku: Vložení dyn.bliku s parametrem

johny
18.12.2006, 13:35
Zdravím,
hledám nějakou funkci, nebo nějaký způsob, jak vložit do výkresu dynamický blok s definovaným parametrem (viditelnost, délka lineárního protažení, bod apod.).. Asi nejlepsi by bylo kdyby se u tech parameteru někde zapla vlastnost "zeptej se při vložení"... a pak to fungovalo podobně jako u atributu... Vim, že něco takoveho jde přes palety, ale potřeboval bych to z přikazoveho řadku, abych to mohl změnit programkem....
dik.

Chop
20.12.2006, 14:10
Je to podobné jako přístup k atributům bloku. Vyzkoušejte toto makro. Využívá staženého bloku z katalogu Cad Fóra "Horizontální_formáty.dwg" (děkuji autorovi). Tento blok má pouze možnost změny typu ráměčku (visibility) a pokud je vložen "obyčejně", tak se vloží jako A4. Tohle jej vloží jako "A0" …
Sub Dynblk()Dim vklbod As VariantDim novyblk As AcadBlockReferencevklbod = 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 jEnd Ifnovyblk.UpdateEnd Sub

johny
20.12.2006, 15:43
Diky, ale pri spusteni me to dela nejakou chybu... Bohuzel Visual Basicu nerozumim, svy programky delam v AutoLispu. Jde vubec podobna funkce udelat v AutoLisu? J

Chop
20.12.2006, 19:15
Potřeboval bych detailnější popis chyby. Makro jsem zkoušel a fungovalo jinak bych jej sem neumístil. Tak mne napadá jestli máte stažený blok
Horizontální_formáty.dwg
 
a umístěný do adresáře, kde jej může ACAD najít…

johny
21.12.2006, 14:39
Asi byl orpavdu problem v jinem umisten.. ted uz to funguje..  Mohl bych vás jeste poprosit o úpravu (predpoládám, že snadnou) abych tu funkci mohl vyuzit jen volanim z prikazove radky resp. přímo z autolispu.. např ve formatu... -vbarun dynblk JmenoBloku JmenoParametru HodnotaParametru. Děkuji moc.

Chop
22.12.2006, 08:31
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 VariantDim novyblk As AcadBlockReferencevklbod = 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 jEnd Ifnovyblk.UpdateEnd 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…
 
 

Chop
02.01.2007, 09:08
Dobrý den, omlouvám se všem, kteří to již zkoušeli a zjistili, že výše uvedené makro není funkční. Bohužel volání procedury s parametry funguje uvnitř VBA, ale ne z příkazového řádku.
Zde je upravené makro, které mění požadované vlastnosti (není ošetřeno na chyby v zadání):
 
Sub Dynblk()Dim vklbod As VariantDim novyblk As AcadBlockReferenceJmenoBloku = 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 jEnd Ifnovyblk.UpdateEnd 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.

johny
02.01.2007, 11:03
Zdravím, děkuji za ochotu, v vánocích jsem se na to díval a dle vašeho vzoru a nápovědy jsem si to upravil do tvaru, který jsem potřeboval. Na problém předávání parametrů jsem narazil a vyřešil stejně jako vy.
Tedy:
Sub Dynblk()Dim Vklbod As VariantDim Novyblk As AcadBlockReferenceDim Jmeno As StringDim bodX As DoubleDim bodY As DoubleDim Meritko As DoubleDim HVyska As StringDim DVyska As StringDim Otoceni As DoubleJmeno = 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 IfNovyblk.UpdateEnd 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.

Chop
02.01.2007, 11:48
[QUOTE=johny]
Jinak je trochu problém s obecným zadáním typu parametru, páč hodnotu nelze vždy přečíst getstring[/QUOTE]
 
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.

johny
02.01.2007, 13:06
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.

johny
09.01.2007, 19:25

Zdravim,
mam problem pri vkladani tech dynamickych bloku. Na obrazcich jsou stejne situace, pouze se zmenenym meritkem. Pokud je meritko 1, pak funguje vse bez problemu. Pokud jej ale zmenim (tady 0.7), pak me ten blok vloží sice se správnými vlastnostmi (tj. bod vlozeni, otoceni i meritko) ale puvodne dynamicky blok vlozi jako normalni (If Novyblk.IsDynamicBlock vrati False). Ale zase pokud bod vlozeni je relativne blizky 0,0 tak funguji i ruzna meritka (zkousel jsem 1000,1000 a fungoval, ale 50000,50000 uz ne...).
Prosim muzete me nekdo poradit co delam spatne?? Predpokladam, ze kdyz dynamicky blok vlozi jako normalni, tak je to asi nejaka chyba... Nemate nekdo s tim zkusenosti.. kdy to se tak stava??
diky moc.
 
 
 

 
 

Chop
16.01.2007, 06:22
Musím potvrdit podivné převody dynamických bloků na normální, ale u mne to dělá až když zmenším měřítko velmi výrazně tj. v properties je scale zobrazováno jako 0 - to bych si tipoval na zaokrouhlovací chybu.
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?