Hi Swampers,
Does anybody know of a routine to project shading from a selected point or object?
I currently have a dialog based routine (quickly and sloppily written w/no error checking) that projects shading off a point using a latitude of 36.
Any help enhancing the code would be greatly appreciated.
(defun addshade_dialog ( / fn)
(setq fname (vl-filename-mktemp "AddShade.dcl"))
(setq fn (open fname "w"))
(write-line "AddShade : dialog { label = \"AddShade.lsp\";
:boxed_column { label = \"Time Specification\";
: popup_list { label = \"Start Time:\";
key = \"Selection1\"; edit_width = 25;
}
: popup_list { label = \"End Time:\";
key = \"Selection2\"; edit_width = 25;
}
}
:boxed_column { label = \"Object Info\";
: popup_list { label = \"Layer:\";
key = \"Selection3\"; edit_width = 25;
}
: edit_box { label = \"Object Height :\";
key = \"OBJH\"; alignment = centered; edit_limit = 35;
edit_width = 30; }}
:row {
: button { key = \"accept\"; label = \"Place Shade\"; mnemonic = \"P\";is_default = true; edit_width = true; alignment = centered;}
: button { key = \"cancel\"; label = \"Cancel\"; mnemonic = \"C\";edit_width = true; alignment = centered; is_cancel = true;}
}
: errtile { width = true; } }" fn)
(close fn)
);defun
(defun AddLWPline (spc pts);(cmwade77)
(setq pts (apply 'append (mapcar '(lambda (pt) (list (car pt) (cadr pt))) pts))
pts (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
pts)))
(vla-addlightweightpolyline spc pts)
)
(defun c:AddShade ( / Bottom Right ObjectHeight ObjectPoint ObjectPointX ObjectPointY
ObjectPointList ObjectPointList2 Doc Mspc TimeList fname layers newlayer)
(setq Doc (vla-get-activedocument (vlax-get-acad-object))
Mspc (vla-get-modelspace Doc)
)
(vl-cmdf "ucs" "w")
(Setq TimeList
(MAPCAR 'VL-PRIN1-TO-STRING
'(8:00:00AM 8:15:00AM 8:30:00AM 8:45:00AM 9:00:00AM 9:15:00AM 9:30:00AM 9:45:00AM
10:00:00AM 10:15:00AM 10:30:00AM 10:45:00AM 11:00:00AM 11:15:00AM 11:30:00AM 11:45:00AM
12:00:00PM 12:15:00PM 12:30:00PM 12:45:00PM 1:00:00PM 1:15:00PM 1:30:00PM 1:45:00PM
2:00:00PM 2:15:00PM 2:30:00PM 2:45:00PM 3:00:00PM 3:15:00PM 3:30:00PM 3:45:00PM 4:00:00PM
)))
(setq layers (cons (getvar "clayer")(acad_strlsort (ai_table "layer" 4))))
(addshade_dialog)
(setq dcl_id (load_dialog fname))
(or (new_dialog "AddShade" dcl_id)(exit))
(start_list "Selection1")
(mapcar 'add_list TimeList)
(end_list)
(start_list "Selection2")
(mapcar 'add_list TimeList)
(end_list)
(start_list "Selection3")
(mapcar 'add_list layers)
(end_list)
(Set_Tile "OBJH" "10.5")
(setq ObjectHeight 10.5)
(if StartTime (set_Tile "Selection1" (itoa (vl-position StartTime TimeList))))
(if EndTime (set_Tile "Selection2" (itoa (vl-position EndTime TimeList))))
(action_tile "Selection1" "(setq StartTime (atoi(get_tile \"Selection1\")))")
(action_tile "Selection2" "(setq EndTime (atoi(get_tile \"Selection2\")))")
(action_tile "Selection3" "(setq newlayer (atoi(get_tile \"Selection3\")))")
(action_tile "OBJH" "(setq ObjectHeight (atof $value))")
(action_tile "accept" (strcat "(progn
(setq StartTime (atoi(get_tile \"Selection1\")))
(setq EndTime (atoi(get_tile \"Selection2\")))
(setq newlayer (atoi(get_tile \"Selection3\")))
(done_dialog)(setq userclick T))"));action_tile
(action_tile "cancel" (strcat "(progn (vl-file-delete fname)(princ \"\nCancel\")(exit))"));action_tile
(start_dialog)
(unload_dialog dcl_id)
(setq StartTime (nth StartTime TimeList))
(setq EndTime (nth EndTime TimeList))
(setq newlayer (nth newlayer layers))
(vl-cmdf "-layer" "on" newlayer "thaw" newlayer "unlock" newlayer "")
(setvar 'clayer newlayer)
(setq bottom
(reverse(list 5.788512 4.270908 3.336629 2.698563 2.229288 1.865523 1.572891 1.329867 1.121739
0.939523 0.776877 0.628903 0.491612 0.362089 0.23851 0.118316 0 -0.118316
-0.23851 -0.362089 -0.491612 -0.628903 -0.776877 -0.939523 -1.121739 -1.329867 -1.572891
-1.865523 -2.229288 -2.698563 -3.336629 -4.270301 -5.788512
))
)
(setq right
(reverse (list 4.308341 3.478306 2.980148 2.65002 2.415857 2.243048 2.110964 2.00921 1.928889 1.86479
1.81434 1.774983 1.74429 1.721215 1.705724 1.696255 1.693605 1.696255 1.705724 1.721215
1.74429 1.774983 1.81434 1.86479 1.928889 2.00921 2.110964 2.243048 2.415857 2.65002
2.980148 3.479051 4.308341
))
)
(setq count 0)
(setq ObjectPoint (getpoint "\nObject Point:"))
(setq ObjectPointX (car ObjectPoint))
(setq ObjectPointY (cadr ObjectPoint))
(setq ObjectPointList (cons ObjectPoint (mapcar '(lambda (x y) (list (+ ObjectPointX (* ObjectHeight x)) (+ ObjectPointY (* ObjectHeight y))))
(reverse (member (nth (vl-position EndTime (reverse TimeList)) (reverse (member(nth(vl-position StartTime TimeList) bottom)bottom)))(reverse (member(nth(vl-position StartTime TimeList) bottom)bottom))))
(reverse (member (nth (vl-position EndTime (reverse TimeList)) (reverse (member(nth(vl-position StartTime TimeList) right)right)))(reverse (member(nth(vl-position StartTime TimeList) right)right))))
)))
(vla-put-closed (AddLwpline Mspc ObjectPointList) :vlax-true)
(repeat (+ (- (vl-position EndTime TimeList) (vl-position StartTime TimeList)) 2) (setq objectpointlist2 (append objectpointlist2 (list ObjectPoint (nth count objectpointlist))))(setq count (1+ count)))
(AddLwpline Mspc ObjectPointList2)
(princ)
);
