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:

vba error message

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

Popular posts from this blog

javascript - jQuery: Add class depending on URL in the best way -

caching - How to check if a url path exists in the service worker cache -

Redirect to a HTTPS version using .htaccess -