0 Members and 2 Guests are viewing this topic.
(defun c:ddla (/ ar1 ar2 tab oba inspoint objarea)(vl-load-com)(setq areanamelist(list "RoomA" "RoomB" "RoomC" "RoomD" "RoomE"))(setq DH (load_dialog "DDlabelarea"))(new_dialog "DDlabelarea" DH)(start_list "areanamelist")(mapcar 'add_list areanamelist)(end_list)(action_tile "accept" "(done_dialog 1) (setq area-name (get_tile \"areanamelist\"))")(action_tile "cancel" "(exit)(exit)")(setq RET (start_dialog))} (setvar "cmdecho" 1) (setq fd (getvar "fielddisplay")) (if (/= fd 1)(setvar"fielddisplay" 1))(setq ar1 (entsel "\nSelect Area Boundary: "))(setq ar2 (car ar1))(setq tab (vlax-ename->vla-object ar2))(setq oba (vla-get-objectid tab))(princ);;(setq inspoint (getpoint "\nPick label insertion point: "))(princ)(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, m2]%ds44%ct8[1e-006]\">%"))(setvar "attdia" 0)(setvar "attreq" 1)(setq schaal (rtos(getvar "userr1"))) (princ objarea) (princ area-name) ;;(command "-insert" "oppervlakte" "s" schaal inspoint "" area-name objarea )(setvar "attdia" 1)(setvar "attreq" 1)(princ))
(defun c:ddla (/ ar1 ar2 tab oba inspoint objarea)(vl-load-com)(setq areanamelist(list "RoomA" "RoomB" "RoomC" "RoomD" "RoomE"))(setq DH (load_dialog "DDlabelarea"))(new_dialog "DDlabelarea" DH)(start_list "areanamelist")(mapcar 'add_list areanamelist)(end_list)(action_tile "accept" "(setq area-name (get_tile \"areanamelist\"))(done_dialog 1)")(action_tile "cancel" "(exit)(exit)")(setq RET (start_dialog))} (setvar "cmdecho" 1) (setq fd (getvar "fielddisplay")) (if (/= fd 1)(setvar"fielddisplay" 1))(setq ar1 (entsel "\nSelect Area Boundary: "))(setq ar2 (car ar1))(setq tab (vlax-ename->vla-object ar2))(setq oba (vla-get-objectid tab))(princ)(setq inspoint (getpoint "\nPick label insertion point: "))(princ)(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, m2]%ds44%ct8[1e-006]\">%"))(setvar "attdia" 0)(setvar "attreq" 1)(setq schaal (rtos(getvar "userr1"))) (princ objarea) (print area-name) (command "-insert" "oppervlakte" "s" 1.0 inspoint "" (nth (atoi area-name) areanamelist) objarea )(setvar "attdia" 1)(setvar "attreq" 1)(princ))
(defun do_pick (/ area1) (while (setq area1 (entsel "\nSelect polyline: ")) (if (member (cdr (assoc 0 (setq entlst (entget (car area1))))) '("LWPOLYLINE" )) ) (prompt "\nError selected object is NOT a LWpolyline.") ) ) (if (null area1) (prompt "\nNothing selected.............................") ))
(setq area1 (entsel "\nSelect Area Boundary: "))(setq area2 (car area1))(setq tab (vlax-ename->vla-object area2))(setq oba (vla-get-objectid tab))
(do_pick)(setq area2 (car area1))(setq tab (vlax-ename->vla-object area2))(setq oba (vla-get-objectid tab))
(cond ((= area-name "RoomA") (setq DblHatch "_n") ) ((= area-name "Toilet") (setq DblHatch "_y") ))(command "_.bhatch" "_s" ar1 hatchobjects "" "_p" "_u" "45" "150" DblHatch "")
(while (not (setq ss (ssget ":e:s" '((0 . "LWPOLYLINE") (70 . 1))))))
(cond((= area-name "RoomA") (setq DblHatch "_n")(setq AngHatch "45"))((= area-name "Toilet") (setq DblHatch "_y")(setq AngHatch "135")))(command "_.bhatch" "_s" ar1 hatchobjects "" "_p" "_u" AngHatch "150" DblHatch "")