Topic: Working on Xp(32) but not on W7(64)

[MvdP]

This is a part of my code (add area in in atribute) and it is working on WXP(32) and autocad 2010

Code: [Select]

(setq tab (vlax-ename->vla-object area2))
(setq oba (vla-get-objectid tab))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps[, m2]%ds44%ct8[1e-006]\">%"))

But its not working on W7(64) and i don't know why.

[Lee Mac]

This is what I use to get the ObjectID on 32/64 systems:

Code: [Select]

(defun GetObjectID ( obj doc ) ;; Lee Mac
  (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
    (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
    (itoa (vla-get-Objectid obj))
  )
)


[MvdP]

OK.
So there is indeed a difference in object id between 32/64 OS
But i cant seem to figure out how to implement this in my code.

[Lee Mac]

You will need to feed it the VLA-Object for which you wish to retrieve the ObjectID, and the ActiveDocument.

Code: [Select]

(GetObjectID <VLA-Object> <ActiveDocument>)

It will then return the ObjectID as a string.

[MvdP]

Sorry Lee but i am totaly lost in here.I was so free to post all of my code.

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; error handling

(defun traperror (errmsg)
(setq *error* temperr)
(sssetfirst nil ss)
(SETQ ent (SSNAME ss 0))
(redraw ent 4)
(prompt "\nDDRuimteLabeller geannuleerd door gebruiker....!")
(princ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; error handling
(defun c:DDRuimteLabel (/ areanamelist rotationlist precisionlist ddla area-name rotation precision suffix
                        fd ss area1 area2 tab oba ddr inspoint objarea anghatch dblhatch schaal hatchobject)


(setq temperr *error*)
(setq *error* traperror)

  
(setq areanamelist(list
"badkamer"                 ;0  <---- hatchslide 4
"berging"                  ;1  <---- hatchslide 4
"cv"                       ;2  <---- hatchslide 4
"gebruiksoppervlakte"      ;3  <---- hatchslide 5
"mk"                       ;4  <---- hatchslide 4
"ls"                       ;5  <---- hatchslide 4
"onbenoemde ruimte"        ;6  <---- hatchslide 2
"techniek"                 ;7  <---- hatchslide 4
"toilet"                   ;8  <---- hatchslide 4
"verblijfsgebied A"        ;9  <---- hatchslide 1
"verblijfsgebied B"        ;10 <---- hatchslide 1
"verblijfsgebied C"        ;11 <---- hatchslide 1
"verblijfsgebied D"        ;12 <---- hatchslide 1
"verblijfsgebied E"        ;13 <---- hatchslide 1
"verkeersgebied"           ;14 <---- hatchslide 3
))

(setq rotationlist (list "0" "45" "90" "135" "180" "225" "270" "315"))
(setq precisionlist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000" "0.000000" "0.0000000" "0.00000000"))

  ; ************************************************
  (defun txtbox_infohulp ()
    (alert
      (strcat
        "DDRuimteLabeller Help.\n\n"
"Met deze routine kan je een ruimte benoemen en de oppervlakte hiervan (1 gesloten polyline) wordt automatisch berekend.\n"
"Er wordt een gekozen block -ruimtelabel- geplaatst met 2 attributen.\n\n"
"Block 1.\n"
"Benaming    2mm.\n"
"Oppervlakte 1mm.\n\n"
"Block 2.(Default)\n"
"Benaming    1mm.\n"
"Oppervlakte 1mm.\n\n"
"Block 3.\n"
"Benaming    2mm.\n"
"Oppervlakte 2mm.\n\n"
        "1 attribuut voor ruimtebenaming (te kiezen uit dropdown-list) en 1 attribuut voor de oppervlakte in m2.\n"
        "De geselecteerde polyline wordt automatisch gearceerd.\n\n"
"Als de polyline wordt aangepast worden automatisch de metrage en ook de arcering aangepast (tekst pas na een regen).\n\n"
        "Klik op OK om dit venster te sluiten.\n\n"
       )
    )
  )
; ************************************************
  
(setq DDLA (load_dialog "DDRuimteLabel"))
(new_dialog "DDRuimteLabel" DDLA)
  
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)

(start_list "rotationlist")
(mapcar 'add_list rotationlist)
(end_list)

(start_list "precisionlist")
(mapcar 'add_list precisionlist)
(end_list)


(start_image "image1")
(slide_image 0 0 (dimx_tile "image1")(dimy_tile "image1") "ruimtelabel1.sld")
(end_image)

(start_image "image2")
(slide_image 0 0 (dimx_tile "image2")(dimy_tile "image2") "ruimtelabel2.sld")
(end_image)

(start_image "image3")
(slide_image 0 0 (dimx_tile "image3")(dimy_tile "image3") "ruimtelabel3.sld")
(end_image)

(defun areanamelist_action (hp / x y)
  (cond
    ((member hp '( "9" "10" "11" "12" "13"))
     (setq hatchpattern "hatch1.sld")
     )
    ((= hp "6")
     (setq hatchpattern "hatch2.sld")
      )
    ((= hp "14")
     (setq hatchpattern "hatch3.sld")
     )
    ((member hp '("0" "1" "2" "4" "5" "7" "8"))
     (setq hatchpattern "hatch4.sld")
     )
    ((= hp "3")
     (setq hatchpattern "hatch5.sld")
     )
  )
  (start_image "hatchimage")
  (setq x (dimx_tile "hatchimage"))
  (setq y (dimy_tile "hatchimage"))
  (fill_image 0 0 x y 0) ; clear image, 0 = black background -15 = gray)
  (slide_image 0 0 x y hatchpattern)
  (end_image)
)
  

(set_tile "precisionlist" "2")
(action_tile "accept" "(setq ruimtelabelblock (get_tile \"ruimtelabelblocklist\"))(setq area-name (get_tile \"areanamelist\"))(setq rotation (get_tile \"rotationlist\"))(setq precision (get_tile \"precisionlist\"))(setq suffix (get_tile \"suffixlist\"))(done_dialog 1)")
(action_tile "areanamelist" "(areanamelist_action $value)")
(set_tile "areanamelist" "0")
(mode_tile "copyright" 1)
(areanamelist_action "2")
(action_tile "hulp" "(txtbox_infohulp)")
(action_tile "cancel" "(done_dialog 0)")
(setq DDR (start_dialog))}

(if (equal DDR 0)
(prompt "\n DDRuimteLabeller geannuleerd door gebruiker....!")
(progn
  
(setvar "cmdecho" 0)
(setq fd (getvar "fielddisplay"))
(if (/= fd 1)(setvar"fielddisplay" 1))

(prompt "\nSelecteer een GESLOTEN Polyline: ")
(while (not (setq ss (ssget "_:E:S" '((0 . "LWPOLYLINE") (70 . 1)))))
(prompt "\nGeselecteerd object is GEEN gesloten Polyline.... "))
(sssetfirst nil ss)


(setq area1 (ssname ss 0))
(setq area2 area1)
(setq tab (vlax-ename->vla-object area2))
(setq oba (vla-get-objectid tab))




(princ)
(setq inspoint (getpoint "\nKies Ruimtelabel block insertion point:"))
(princ)
(setq areaname (nth (atoi area-name) areanamelist))
(setq precision (nth (atoi precision) precisionlist))

(cond
((and (= suffix "suffix1")(= precision "0"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix1")(= precision "0.0"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix1")(= precision "0.00"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix1")(= precision "0.000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix1")(= precision "0.0000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix1")(= precision "0.00000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix1")(= precision "0.000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix1")(= precision "0.0000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix1")(= precision "0.00000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps[, m2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0.0"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0.00"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0.000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0.0000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0.00000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0.000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0.0000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix2")(= precision "0.00000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps[, M2]%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0.0"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0.00"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0.000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0.0000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0.00000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0.000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0.0000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps%ds44%ct8[1e-006]\">%")))
((and (= suffix "suffix3")(= precision "0.00000000"))(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps%ds44%ct8[1e-006]\">%")))
)
(cond
((= areaname "onbenoemde ruimte")(setq anghatch "135")(setq dblhatch "n")  (setq hatch-area "J"))
((= areaname "verblijfsgebied A")(setq anghatch "45") (setq dblhatch "n")  (setq hatch-area "J"))
((= areaname "verblijfsgebied B")(setq anghatch "45") (setq dblhatch "n")  (setq hatch-area "J"))
((= areaname "verblijfsgebied C")(setq anghatch "45") (setq dblhatch "n")  (setq hatch-area "J"))
((= areaname "verblijfsgebied D")(setq anghatch "45") (setq dblhatch "n")  (setq hatch-area "J"))
((= areaname "verblijfsgebied E")(setq anghatch "45") (setq dblhatch "n")  (setq hatch-area "J"))
((= areaname "verkeersgebied")   (setq anghatch "45") (setq dblhatch "y")  (setq hatch-area "J"))
((= areaname "gebruiksoppervlakte")(setq makelayer "raster25")(setq layercolor "251") (setq raster-area "J"))
)


(setq currentlayer (getvar "clayer"))
(setvar "attdia" 0)
(setvar "attreq" 1)

(command "-layer" "s" "0" "")
(setq schaal (rtos(getvar "userr1")))
(command "-insert" ruimtelabelblock "s" schaal inspoint (nth (atoi rotation) rotationlist) (nth (atoi area-name) areanamelist) objarea )
(setq hatchobject(entlast))
 

(setq area-name (nth (atoi area-name) areanamelist))


(if (= hatch-area "J")
(command "-layer" "make" "00---0-a_Arceer" "color" "1" "00---0-a_Arceer" "LW" "0.18" "00---0-a_Arceer" "" "-bhatch" "s" area1 hatchobject "" "p" "u" anghatch "250" dblhatch "")
)


(if (= raster-area "J")
(command "-layer" "make" makelayer "color" layercolor "" ""  "-bhatch" "s" area1 "" "p" "solid" "")
)


(command "-layer" "s" currentlayer "")
(setq areaname nil )
(setq hatch-area nil )
(setq raster-area nil )
(setq hatchobject nil )
(setq suffix nil )
(setq anghatch nil )
(setq dblhatch nil)
(setq makelayer nil)
(setq layercolor nil)
(setvar "attdia" 1)
(setvar "attreq" 1)
)
)
(princ)
;;(princ "\nKlaar.")
(princ)
)


[Lee Mac]

Change:

Code: [Select]

(setq oba (vla-get-objectid tab))

to

Code: [Select]

(setq oba (GetObjectID tab (vla-get-ActiveDocument (vlax-get-acad-object))))

And

Code: [Select]

(rtos oba 2 0)

to

Code: [Select]

oba

[MvdP]

Thank you very much Lee.. That did the trick.
You're the man.

[Lee Mac]

You're welcome