This AutoCAD VBA code will not compile - passing a TYPE as a VARIANT -
i have following vba code being compiled , executed inside autocad 2014 (64 bit):
option explicit type hatchdata itag integer itype integer strpattern string dscale double strlayer string end type public sub updatehatches() dim maphatches collection call readhatchini(maphatches) msgbox "finished" end sub private function readhatchini(byref maphatches collection) dim vpath variant vpath = m_creg.queryvalue("software\pathxxx", "hatchespathini") m_cini .path = vpath .section = "hatches" .key = "numhatches" .default = 0 dim ihatch integer, inumhatches integer dim strhatchdata string dim arystrtokens() string inumhatches = .value .default = "" ihatch = 1 inumhatches .key = "hatch" & cstr(ihatch) strhatchdata = .value if (strhatchdata <> "") arystrtokens = split(strhatchdata, " ", , vbtextcompare) ' todo: ok declare variable here ? dim ohatchdata hatchdata ohatchdata.itag = arystrtokens(0) ohatchdata.itype = arystrtokens(1) ohatchdata.strpattern = arystrtokens(2) ohatchdata.dscale = arystrtokens(3) ohatchdata.strlayer = arystrtokens(4) ' todo: can't pass hatchdata object call cset(maphatches, cstr(ohatchdata.itag), ohatchdata) end if next end end function private sub cset(byref col collection, key string, item variant) if (chas(col, key)) col.remove key col.add array(key, item), key end sub private function cget(byref col collection, key string) variant if not chas(col, key) exit function on error resume next err.clear set cget = col(key)(1) if err.number = 13 err.clear cget = col(key)(1) end if on error goto 0 if err.number <> 0 call err.raise(err.number, err.source, err.description, err.helpfile, err.helpcontext) end function public function chas(col collection, key string) boolean chas = true on error resume next err.clear col (key) if err.number <> 0 chas = false err.clear end if on error goto 0 end function private sub cremove(byref col collection, key string) if chas(col, key) col.remove key end sub private function ckeys(byref col collection) string() dim initialized boolean dim keys() string each item in col if not initialized redim preserve keys(0) keys(ubound(keys)) = item(0) initialized = true else redim preserve keys(ubound(keys) + 1) keys(ubound(keys)) = item(0) end if next item ckeys = keys end function
i have specific issue related code:
' todo: can't pass hatchdata object call cset(maphatches, cstr(ohatchdata.itag), ohatchdata)
this vba error message displays when try run it:
how can change code can populate collection?
thank !
andrew
having come across related question:
user defined type (udt) parameter in public sub in class module (vb6)
i decided change logic. have simple list of hatchdata objects , collection mapping tag index in list.
this compiles , runs fine. when index map can hatchdata list using lookup map index.
option explicit type hatchdata itag integer itype integer strpattern string dscale double strlayer string end type public sub updatehatches() dim aryhatches() hatchdata dim maphatches collection set maphatches = new collection call readhatchini(aryhatches, maphatches) msgbox "finished" end sub private function readhatchini(byref aryhatches() hatchdata, byref maphatches collection) dim vpath variant vpath = m_creg.queryvalue("software\pathxxxxx", "hatchespathini") m_cini .path = vpath .section = "hatches" .key = "numhatches" .default = 0 erase aryhatches dim ihatch integer, inumhatches integer dim strhatchdata string dim arystrtokens() string inumhatches = .value .default = "" ihatch = 0 inumhatches - 1 .key = "hatch" & cstr(ihatch + 1) strhatchdata = .value if (strhatchdata <> "") arystrtokens = split(strhatchdata, " ", , vbtextcompare) redim preserve aryhatches(0 ihatch) aryhatches(ihatch) .itag = arystrtokens(0) .itype = arystrtokens(1) .strpattern = arystrtokens(2) .dscale = arystrtokens(3) .strlayer = arystrtokens(4) end ' todo: can't pass hatchdata object call cset(maphatches, cstr(aryhatches(ihatch).itag), ihatch) end if next end ' end have list of hatchdata objects ' , lookup map of tag id hatchdata index positions end function private sub cset(byref col collection, key string, item variant) if (chas(col, key)) col.remove key call col.add(item, key) end sub private function cget(byref col collection, key string) variant if not chas(col, key) exit function on error resume next err.clear set cget = col(key)(1) if err.number = 13 err.clear cget = col(key)(1) end if on error goto 0 if err.number <> 0 call err.raise(err.number, err.source, err.description, err.helpfile, err.helpcontext) end function public function chas(col collection, key string) boolean chas = true on error resume next err.clear col (key) if err.number <> 0 chas = false err.clear end if on error goto 0 end function private sub cremove(byref col collection, key string) if chas(col, key) col.remove key end sub
Comments
Post a Comment