Sorry Lee but i am totaly lost in here.I was so free to post all of my code.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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)
)