;; --------------------------------------------------------------- ;; Lira Nikolovska, MIT Architecture ;; ;; FRITZ GLARNER Grammar by Terry Knight ;; 4.207 Final project, Spring 2001 ;; --------------------------------------------------------------- ;; FUNCTIONS: ;; c:glarner ;; c:divideCanvas ;; c:wedge_rules ;; c:paint ;; ;; make_new_layer ;; insert, points_rect, draw_rect ;; entity_to_points, find_first_10_index ;; divideRect_hor, divideRect_vert ;; check_layer ;; horizontal_wedge, vertical_wedge ;; small_wedge ;; make4points ;; paint_rectangles ;; rand16, rand ;; --------------------------------------------------------------- (command "ucs" "w" "") (command "_view" "o" "t" "") ;; set ortho top view (command "shademode" "G") ;; gouraud shaded ;;(command "shademode" "F") ; flat shaded ;; --------------------------------------------------------------- ;; set up layers, global variable *holdLayerNumber* ;; --------------------------------------------------------------- (setq *holdLayerNumber* 1) (defun make_new_layer (/ layerCounter layerNumber) (setq layerCounter *holdLayerNumber*) (setq layerNumber layerCounter) ;(itoa layerNumber) ;; "itoa" converts integer to string (command "layer" "new" layerNumber "color" layerCounter layerNumber "") ; (command "layer" "new" layerNumber "color" "11" layerNumber "") (command "layer" "set" layerNumber "") (setq *holdLayerNumber* (+ *holdLayerNumber* 1)) ) ; close defun ;; ------------------------------- ;; make new layer with white color ;; -------------------------------- (defun make_new_layer_2 (/ layerCounter layerNumber) (setq layerCounter *holdLayerNumber*) (setq layerNumber layerCounter) (command "layer" "new" layerNumber "color" "white" layerNumber "") (command "layer" "set" layerNumber "") (setq *holdLayerNumber* (+ *holdLayerNumber* 1)) ) ; close defun ;; --------------------------------------------------------------- ;; insert point 1 (p1) and point 3 (p3) of the rectangle (canvas) ;; --------------------------------------------------------------- (defun insert () (setq p1 (getpoint "\nInsert the first point of the canvas. ")) (print "point 1 = ") (princ p1) (setq p3 (getpoint "\nInsert the second point of the canvas. ")) (print "point 3 = ") (princ p3) (points_rect) ) ;; ----------------------------------------------------- ;; determine point 2 (p2) and point 4 (p4) of rectangle ;; ----------------------------------------------------- (defun points_rect () (setq p2 (list (car p3) (cadr p1) 0.0)) (print "point 2 = ") (princ p2) (setq p4 (list (car p1) (cadr p3) 0.0)) (print "point 4 = ") (princ p4) (draw_rect) ) ;; -------------------------------------------------------- ;; draw the rectangle / canvas ;; -------------------------------------------------------- (defun draw_rect () (command "pline" p1 p2 p3 p4 "c") ;;; (setq mainCanvas (entlast)) (command "layer" "lock" "canvas" "") (princ) ) ;; --------------------------------------------------------- ;; take an polyline entity and returns a list of points. ;; --------------------------------------------------------- (defun entity_to_points (entity / index entity_info numsides) (setq entity_info (entget entity)) (setq index (find_first_10_index entity_info)) (setq numsides (cdr (assoc 90 entity_info))) (setq pointslist (list (cdr (nth index entity_info)))) (repeat (- numsides 1) (setq index (+ index 4)) (setq point (cdr (nth index entity_info))) (setq pointslist (cons point pointslist)) ) (reverse pointslist) ) ;_ end of entity_to_points ;; --------------------------------------------------------- ;; find the first point in a list ;; --------------------------------------------------------- (defun find_first_10_index (alist / total_length index) (setq total_length (length alist)) (setq index 0) (repeat (- total_length 1) (if (= (nth index alist) (assoc 10 alist)) index (setq index (+ index 1)) ) ; close if ) ; close repeat ) ; close defun find_first_10 ;; --------------------------------------------------------------------------------------------- ;; divide canvas: choose btw horizontal and vertical division, or quit if done splitting canvas ;; --------------------------------------------------------------------------------------------- (defun c:divideCanvas () (first) (second) ) (defun first () (setq DONE nil) (while (not DONE) (setq an (getstring "\n Horizontal, vertical division of the canvas or done? H/V/D " ) ) (if (= an "h") ;; horizontal division (divideRect_hor) (setq DONE nil) ) (if (= an "v") ;; vertical division (divideRect_vert) (setq DONE nil) ) (if (= an "d") ;; done (second) ;; second is exit function ) ) ; close while (princ) ) ; close defun first (defun second () (prompt "\n You have finished dividing the canvas. ") (quit) ;; how can i avoid getting error message? (princ) ) ; close defun second ;;;(defun 3dPoint->2dPoint (3dpt)(list (car 3dpt) (cadr 3dpt))) ;; ------------------------------------- ;; horizontal division of the rectangle ;; ------------------------------------- (defun divideRect_hor (/ pointslist tempPT abovePoly belowPoly) (make_new_layer) (setq tempPT (getpoint "\n Click inside the canvas to identify horizontal division " ) ) (princ tempPT) (command "bpoly" tempPT "") ;; draw polygon (setq tempPolygon (entlast)) (setq tempPolygon (make4points (entity_to_points tempPolygon))) (print "tempPolygon") (print tempPolygon) (command "erase" "w" (nth 0 tempPolygon) (nth 2 tempPolygon) "") ;;; (command "erase" ;;; (ssget "w" ;;; (nth 0 (entity_to_points tempPolygon)) ;;; (nth 2 (entity_to_points tempPolygon)) ;;; ) ;;; "" ;;; ) (print "tempPT =") (print tempPT) (command "_xline" "h" tempPT "") ;; point error ;; draw horizontal construction line (setq tempLine (entlast)) (command "bpoly" (list (car tempPT) (+ (cadr tempPT) 2.0)) "" ) ;; new stuff starts here (setq tempPolygon (entlast)) (setq tempPolygon (entity_to_points tempPolygon)) (setq tempPolygon (make4points tempPolygon)) (print "tempPolygon") (print tempPolygon) (command "erase" "w" (nth 0 tempPolygon) (nth 2 tempPolygon) "") (command "pline" (nth 0 tempPolygon) (nth 1 tempPolygon) (nth 2 tempPolygon) (nth 3 tempPolygon) "c") (print "drew first rect") ;;; (command "erase" tempPolygon "") ;(setq belowPoly (entlast)) ; poly BELOW line (command "bpoly" (list (car tempPT) (- (cadr tempPT) 2.0)) "" ) ;; new stuff starts here (setq tempPolygon (entlast)) (setq tempPolygon (make4points (entity_to_points tempPolygon))) (print "tempPolygon") (print tempPolygon) (command "erase" "w" (nth 0 tempPolygon) (nth 2 tempPolygon) "") (command "pline" (nth 0 tempPolygon) (nth 1 tempPolygon) (nth 2 tempPolygon) (nth 3 tempPolygon) "c") (print "drew second rect") ;(setq abovePoly (entlast)) ; poly ABOVE line (command "erase" tempLine "") ;;tempPolygon ) ;; close defun divideRect_hor ;;; -------------------------------------------------------- ;;; vertical division of the rectangle ;;; -------------------------------------------------------- (defun divideRect_vert (/ pointslist tempPT) (make_new_layer) (setq tempPT (getpoint "\n Click inside the canvas to identify vertical division " ) ) (princ tempPT) (command "bpoly" tempPT "") ;; draw polygon (setq tempPolygon (entlast)) (setq tempPolygon (make4points (entity_to_points tempPolygon))) (print "tempPolygon") (print tempPolygon) (command "erase" "w" (nth 0 tempPolygon) (nth 2 tempPolygon) "") ;;; (command "erase" ;;; (ssget "w" ;;; (nth 0 (entity_to_points tempPolygon)) ;;; (nth 2 (entity_to_points tempPolygon)) ;;; ) ;;; "" ;;; ) (print "tempPT =") (print tempPT) (command "_xline" "v" tempPT "") ;; point error ;; draw horizontal construction line (setq tempLine (entlast)) (command "bpoly" (list (+ (car tempPT) 2.0) (cadr tempPT)) "" ) ;; new stuff starts here (setq tempPolygon (entlast)) (setq tempPolygon (entity_to_points tempPolygon)) (setq tempPolygon (make4points tempPolygon)) (print "tempPolygon") (print tempPolygon) (command "erase" "w" (nth 0 tempPolygon) (nth 2 tempPolygon) "") (command "pline" (nth 0 tempPolygon) (nth 1 tempPolygon) (nth 2 tempPolygon) (nth 3 tempPolygon) "c") (print "drew first rect") ;;; (command "erase" tempPolygon "") ;(setq belowPoly (entlast)) ; poly BELOW line (command "bpoly" (list (- (car tempPT) 2.0) (cadr tempPT)) "" ) ;; new stuff starts here (setq tempPolygon (entlast)) (setq tempPolygon (make4points (entity_to_points tempPolygon))) (print "tempPolygon") (print tempPolygon) (command "erase" "w" (nth 0 tempPolygon) (nth 2 tempPolygon) "") (command "pline" (nth 0 tempPolygon) (nth 1 tempPolygon) (nth 2 tempPolygon) (nth 3 tempPolygon) "c") (print "drew second rect") (command "erase" tempLine "") ;;tempPolygon ) ;; close defun divideRect_vert ;; -------------------------------------------------------- ;; initiate program ;; -------------------------------------------------------- (defun c:glarner () ;(command "layer" "unlock" "canvas" "") (command "erase" "all" "") (command "layer" "new" "canvas" "color" "white" "canvas" "") (command "layer" "set" "canvas" "") (command "regen") (insert) (command "zoom" "a") ) ;; ------------------------------------------------------- (defun c:wedgeCanvas () (check_layer) ) ;; --------------------------------------------------------------------------------------------- ;; apply one of the splitting rules (1 - 6) and choose between short and long side wedge ;; --------------------------------------------------------------------------------------------- (defun c:wedge_rules () (wedge_rules) ) (defun wedge_rules (/ *angle1* *angle2* DONE an) ;;*wedge* (setq DONE nil) (while (not DONE) (setq an (getstring "\n Apply rule 1, 2, 3, 4, 5 or 6, or done? 1/2/3/4/5/6 " ) ) (setq side (getstring "\n Apply wedge on short or long side? S/L ")) (cond ((and (= an "1") (= side "s")) ;; rule 1 (setq *angle1* 4) (setq *angle2* 86) (setq *wedge* 1) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "2") (= side "s")) ;; rule 2 (setq *angle1* 4) (setq *angle2* 94) (setq *wedge* 1) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "3") (= side "s")) ;; rule 3 (setq *angle1* 4) (setq *angle2* 4) (setq *wedge* 1) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "4") (= side "s")) ;; rule 4 (setq *angle1* 4) (setq *angle2* 176) (setq *wedge* 1) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "5") (= side "s")) ;; rule 5 (setq *angle1* 4) (setq *angle2* 86) (setq *wedge* 1) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "6") (= side "s")) ;; rule 6 (setq *angle1* 86) (setq *angle2* 94) (setq *wedge* 1) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "1") (= side "l")) ;; rule 1 (setq *angle1* 4) (setq *angle2* 86) (setq *wedge* 2) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on LONG side ((and (= an "2") (= side "l")) ;; rule 2 (setq *angle1* 4) (setq *angle2* 94) (setq *wedge* 2) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "3") (= side "l")) ;; rule 3 (setq *angle1* 4) (setq *angle2* 4) (setq *wedge* 2) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "4") (= side "l")) ;; rule 4 (setq *angle1* 4) (setq *angle2* 176) (setq *wedge* 2) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "5") (= side "l")) ;; rule 5 (setq *angle1* 4) (setq *angle2* 86) (setq *wedge* 2) ; 1 =small, 2 = big wedge (check_layer) ) ;; hor or vertical with wedge on SHORT side ((and (= an "6") (= side "l")) ;; rule 6 (setq *angle1* 86) (setq *angle2* 94) (setq *wedge* 2) ; 1 =small, 2 = big wedge (check_layer) ) ) (setq DONE T) ) ) ;;; ----------------------------------------------------------- ;;; check if layer has 2 objects on it. If so, apply wedge rule ;;; ----------------------------------------------------------- (defun check_layer (/ numObjects layerNumber temp ss) (setq layerNumber 1) (while (<= layerNumber *holdLayerNumber*) (setq temp (itoa layerNumber)) ; converts integer to string (princ temp) (setq ss (ssget "_X" (list (cons 8 temp)))) (print ss) ; ss = sel.set: how many objects on first layer (if ss (setq numObjects (sslength ss)) (setq numObjects 0) ) (print "Number of rectangles on this layer = ") (print numObjects) (if (= numObjects 2) (progn (print (entity_to_points (ssname ss 0))) (print (entity_to_points (ssname ss 1))) (print (fix (car (cdr (car (entity_to_points (ssname ss 0)))))) ) (print (fix (car (cdr (car (entity_to_points (ssname ss 1)))))) ) (if (= (fix (car (cdr (car (entity_to_points (ssname ss 0)))))) (fix (car (cdr (car (entity_to_points (ssname ss 1)))))) ) (progn (print "This layer has 2 horizontal rectangles.") (horizontal_wedge ss *angle1* *angle2*) ;; *wedge* (setq ss nil) ) (progn (print "This layer has 2 vertical rectangles.") (vertical_wedge ss *angle1* *angle2*) ;; *wedge* (setq ss nil) )))) (setq layerNumber (+ layerNumber 1)) (print "Layer number = ") (print layerNumber) (print "done!") ) ) ;; -------------------------------------------------------- ;; make horizontal_wedge division ;; -------------------------------------------------------- (defun horizontal_wedge (ss *angle1* *angle2* / p1 p2 p3 p4 tempPolygon tempLine tempPT2 tempPT1 allRectPoints the4points howManyPoints secondRectPoints firstRectPoints tempPT1 tempPT2 tempPT1_y tempPT1_x tempPT2_x tempPT2_y halfDist ) (make_new_layer_2) ;; new layer with white color (print (entity_to_points (ssname ss 0))) (setq firstRectPoints (entity_to_points (ssname ss 0))) (print "first Rect Points=") (print firstRectPoints) (print (entity_to_points (ssname ss 1))) (setq secondRectPoints (entity_to_points (ssname ss 1))) (print "second Rect Points=") (print secondRectPoints) (print "starting with first rectangle . . . ") ; . . . . . . . . . (setq howManyPoints (length firstRectPoints)) (print "Number of all Rect Points=") (print howManyPoints) (setq the4points (make4points firstRectPoints)) ;;; (setq the4points (reverse (make4points the4points))) (print "the 4 new points") (print the4points) (setq p1 (nth 0 the4points)) (print "p1=") (print p1) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (command "erase" "w" p1 p3 "") ;; error here -- it erases neighbouring rects ; distances btw points (setq tempPT1 (list (- (car p3) (car p1)) (- (cadr p1) (cadr p3)))) (setq tempPT1 (list (abs (car tempPT1)) (abs (cadr tempPT1)))) (print "distance btw points=") (print tempPT1) ; half distances btw points (setq tempPT1 (list (/ (car tempPT1) 2) (/ (cadr tempPT1) 2))) (setq tempPT1 (list (abs (car tempPT1)) (abs (cadr tempPT1)))) (print "half distance btw points=") (print tempPT1) ; check X coordinate (check point order) (if (> (cadr p1) (cadr p3)) (progn (setq tempPT1_y (list 1 (+ (cadr p3) (cadr tempPT1)))) (print "tempPT1_y=") (print tempPT1_y)) (progn (setq tempPT1_y (list 1 (+ (cadr p1) (cadr tempPT1)))) (print "tempPT1_y=") (print tempPT1_y)) ) ; close if ; check Y coordinate (check point order) (if (> (car p1) (car p3)) (progn (setq tempPT1_x (list (+ (car p3) (car tempPT1)) 1 )) (print "tempPT1_x=") (print tempPT1_x)) (progn (setq tempPT1_x (list (+ (car p1) (car tempPT1)) 1 )) (print "tempPT1_x=") (print tempPT1_x)) ) ; close if ; (setq tempPT1 (list (car tempPT1_x) (cadr tempPT1_y))) (setq p1 (nth 0 the4points)) (print "p1=") (print p1) (setq p2 (nth 1 the4points)) (print "p2=") (print p2) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (setq p4 (nth 3 the4points)) (print "p4=") (print p4) (setq tempPT1 (inters p1 p3 p2 p4)) (print "the coordinates of tempPT1 are=") (print tempPT1) ; tempPT1 X and Y coordinates (command "_xline" "a" *angle1* tempPT1 "") (setq tempLine (entlast)) (command "bpoly" (list (- (car tempPT1) 5.0) (- (cadr tempPT1) 5.0)) "" ) ; poly above line (print "poly made") (setq firstPoly (entlast)) (print "setq firstPoly done") (command "bpoly" (list (+ (car tempPT1) 5.0) (+ (cadr tempPT1) 5.0)) "" ) ; poly below line (setq secondPoly (entlast)) (command "erase" tempLine "") ;; --------------------------------------------- ;; secondPoly -- note that the list is reversed (print "starting with second rectangle . . . ") (print "second Rect Points=") (print secondRectPoints) (setq howManyPoints (length secondRectPoints)) (print "Number of all Rect Points=") (print howManyPoints) (setq the4points (make4points secondRectPoints)) (print "the 4 points") (print the4points) ;; the problem may be in the fraction? (setq p1 (nth 0 the4points)) (print "p1=") (print p1) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (command "erase" "w" p1 p3 "" ) ;; erases parent rectangle ; distances btw points (setq tempPT2 (list (- (car p3) (car p1)) (- (cadr p1) (cadr p3)))) (setq tempPT2 (list (abs (car tempPT2)) (abs (cadr tempPT2)))) (print "distance btw points=") (print tempPT2) ; half distances btw points (setq tempPT2 (list (/ (car tempPT2) 2) (/ (cadr tempPT2) 2))) (setq tempPT2 (list (abs (car tempPT2)) (abs (cadr tempPT2)))) (print "half distance btw points=") (print tempPT2) ; check X coordinate (if (> (cadr p1) (cadr p3)) (progn (setq tempPT2_y (list 1 (+ (cadr p3) (cadr tempPT2)))) (print "tempPT2_y=") (print tempPT2_y)) (progn (setq tempPT2_y (list 1 (+ (cadr p1) (cadr tempPT2)))) (print "tempPT2_y=") (print tempPT2_y)) ) ; close if ; check Y coordinate (if (> (car p1) (car p3)) (progn (setq tempPT2_x (list (+ (car p3) (car tempPT2)) 1 )) (print "tempPT2_x=") (print tempPT2_x)) (progn (setq tempPT2_x (list (+ (car p1) (car tempPT2)) 1 )) (print "tempPT2_x=") (print tempPT2_x)) ) ; close if ;;; (setq tempPT2 (list (car tempPT2_x) (cadr tempPT2_y))) (setq p1 (nth 0 the4points)) (print "p1=") (print p1) (setq p2 (nth 1 the4points)) (print "p2=") (print p2) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (setq p4 (nth 3 the4points)) (print "p4=") (print p4) (setq tempPT2 (inters p1 p3 p2 p4)) (print "the coordinates of tempPT2 are=") (print tempPT2) (command "_xline" "a" *angle2* tempPT2 "") (setq tempLine (entlast)) (command "bpoly" (list (- (car tempPT2) 5.0) (- (cadr tempPT2) 5.0)) "" ) ; (setq thirdPoly (entlast)) (command "bpoly" (list (+ (car tempPT2) 5.0) (+ (cadr tempPT2) 5.0)) "" ) ; (setq fourthPoly (entlast)) ;; create new selection set for the newly made rectangles (setq thislayer_ss1 (ssadd firstPoly)) (print "created set with one entity") (setq thislayer_ss2 (ssadd secondPoly thislayer_ss1)) (print "second entites added") (setq thislayer_ss3 (ssadd thirdPoly thislayer_ss2)) (print "third entites added") (setq thislayer_ss (ssadd fourthPoly thislayer_ss3)) (print "fourth entites added") (setq howMany (sslength thislayer_ss)) (print "How many objects in the new selection set? ") (print howMany) (command "erase" tempLine "") (small_wedge *wedge*) (command "erase" firstPoly secondPoly thirdPoly fourthPoly "") ) ; (setq firstPoly (entity_to_points firstPoly)) (print "entity_to_points firstPoly done") ;;;;; -------------------------------- ;;;;; make vertical_wedge division ;;;;; -------------------------------- (defun vertical_wedge ( ss *angle1* *angle2* / p1 p2 p3 p4 tempPolygon tempLine tempPT2 lastIndex myPoint tempPT1 tempPT2 tempPT1_y tempPT1_x tempPT2_x tempPT2_y halfDist) (make_new_layer_2) ;; new layer with white color (setq *angle1* (+ *angle1* 90)) (setq *angle2* (+ *angle2* 90)) (print (entity_to_points (ssname ss 0))) (print (entity_to_points (ssname ss 1))) (print (entity_to_points (ssname ss 0))) (setq firstRectPoints (entity_to_points (ssname ss 0))) (print "first Rect Points=") (print firstRectPoints) (print (entity_to_points (ssname ss 1))) (setq secondRectPoints (entity_to_points (ssname ss 1))) (print "second Rect Points=") (print secondRectPoints) (print "starting with first rectangle . . . ") ; . . . . . . . . . (setq howManyPoints (length firstRectPoints)) (print "Number of all Rect Points=") (print howManyPoints) (setq the4points (make4points firstRectPoints)) ;;; (setq the4points (reverse (make4points the4points))) (print "the 4 new points") (print the4points) (setq p1 (nth 0 the4points)) (print "p1=") (print p1) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (command "erase" "w" p1 p3 "") ;; error here -- it erases neighbouring rects ; distances btw points (setq tempPT1 (list (- (car p3) (car p1)) (- (cadr p1) (cadr p3)))) (setq tempPT1 (list (abs (car tempPT1)) (abs (cadr tempPT1)))) (print "distance btw points=") (print tempPT1) ; half distances btw points (setq tempPT1 (list (/ (car tempPT1) 2) (/ (cadr tempPT1) 2))) (setq tempPT1 (list (abs (car tempPT1)) (abs (cadr tempPT1)))) (print "half distance btw points=") (print tempPT1) ; check X coordinate (check point order) (if (> (cadr p1) (cadr p3)) (progn (setq tempPT1_y (list 1 (+ (cadr p3) (cadr tempPT1)))) (print "tempPT1_y=") (print tempPT1_y)) (progn (setq tempPT1_y (list 1 (+ (cadr p1) (cadr tempPT1)))) (print "tempPT1_y=") (print tempPT1_y)) ) ; close if ; check Y coordinate (check point order) (if (> (car p1) (car p3)) (progn (setq tempPT1_x (list (+ (car p3) (car tempPT1)) 1 )) (print "tempPT1_x=") (print tempPT1_x)) (progn (setq tempPT1_x (list (+ (car p1) (car tempPT1)) 1 )) (print "tempPT1_x=") (print tempPT1_x)) ) ; close if ; (setq tempPT1 (list (car tempPT1_x) (cadr tempPT1_y))) (setq p1 (nth 0 the4points)) (print "p1=") (print p1) (setq p2 (nth 1 the4points)) (print "p2=") (print p2) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (setq p4 (nth 3 the4points)) (print "p4=") (print p4) (setq tempPT1 (inters p1 p3 p2 p4)) (print "the coordinates of tempPT1 are=") (print tempPT1) ; tempPT1 X and Y coordinates (command "_xline" "a" *angle1* tempPT1 "") (setq tempLine (entlast)) (setq thislayer_ss (ssadd)) ;; create new sevlection set for the newly made rectangles (command "bpoly" (list (- (car tempPT1) 5.0) (- (cadr tempPT1) 5.0)) "" ) ; poly above line (setq firstPoly (entlast)) (command "bpoly" (list (+ (car tempPT1) 5.0) (+ (cadr tempPT1) 5.0)) "" ) ; poly below line (setq secondPoly (entlast)) (command "erase" tempLine "") ;; --------------------------------------------- ;; secondPoly -- note that the list is reversed (print "starting with second rectangle . . . ") (print "second Rect Points=") (print secondRectPoints) (setq howManyPoints (length secondRectPoints)) (print "Number of all Rect Points=") (print howManyPoints) (setq the4points (make4points secondRectPoints)) (print "the 4 points") (print the4points) ;; the problem may be in the fraction? (setq p1 (nth 0 the4points)) (print "p1=") (print p1) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (command "erase" "w" p1 p3 "" ) ;; erases parent rectangle ; distances btw points (setq tempPT2 (list (- (car p3) (car p1)) (- (cadr p1) (cadr p3)))) (setq tempPT2 (list (abs (car tempPT2)) (abs (cadr tempPT2)))) (print "distance btw points=") (print tempPT2) ; half distances btw points (setq tempPT2 (list (/ (car tempPT2) 2) (/ (cadr tempPT2) 2))) (setq tempPT2 (list (abs (car tempPT2)) (abs (cadr tempPT2)))) (print "half distance btw points=") (print tempPT2) ; check X coordinate (if (> (cadr p1) (cadr p3)) (progn (setq tempPT2_y (list 1 (+ (cadr p3) (cadr tempPT2)))) (print "tempPT2_y=") (print tempPT2_y)) (progn (setq tempPT2_y (list 1 (+ (cadr p1) (cadr tempPT2)))) (print "tempPT2_y=") (print tempPT2_y)) ) ; close if ; check Y coordinate (if (> (car p1) (car p3)) (progn (setq tempPT2_x (list (+ (car p3) (car tempPT2)) 1 )) (print "tempPT2_x=") (print tempPT2_x)) (progn (setq tempPT2_x (list (+ (car p1) (car tempPT2)) 1 )) (print "tempPT2_x=") (print tempPT2_x)) ) ; close if ;;; (setq tempPT2 (list (car tempPT2_x) (cadr tempPT2_y))) (setq p1 (nth 0 the4points)) (print "p1=") (print p1) (setq p2 (nth 1 the4points)) (print "p2=") (print p2) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (setq p4 (nth 3 the4points)) (print "p4=") (print p4) (setq tempPT2 (inters p1 p3 p2 p4)) (print "the coordinates of tempPT2 are=") (print tempPT2) (command "_xline" "a" *angle2* tempPT2 "") (setq tempLine (entlast)) (command "bpoly" (list (- (car tempPT2) 5.0) (- (cadr tempPT2) 5.0)) "" ) ; (setq thirdPoly (entlast)) (command "bpoly" (list (+ (car tempPT2) 5.0) (+ (cadr tempPT2) 5.0)) "" ) ; (setq fourthPoly (entlast)) ;; create new selection set for the newly made rectangles (setq thislayer_ss1 (ssadd firstPoly)) (print "created set with one entity") (setq thislayer_ss2 (ssadd secondPoly thislayer_ss1)) (print "second entites added") (setq thislayer_ss3 (ssadd thirdPoly thislayer_ss2)) (print "third entites added") (setq thislayer_ss (ssadd fourthPoly thislayer_ss3)) (print "fourth entites added") (setq howMany (sslength thislayer_ss)) (print "How many objects in the new selection set? ") (print howMany) (command "erase" tempLine "") (small_wedge *wedge*) (command "erase" firstPoly secondPoly thirdPoly fourthPoly "") ) ;; -------------------------------------- ;; make small_horizontal_wedge ;; -------------------------------- ----- ;;;(defun small_wedge ( *wedge* ) ;;; ) ;;;;; hal's function: gets rid of extra points in a rectangle and returns a list with 4 points (defun deltax (pt1 pt2) (- (fix (car pt1)) (fix (car pt2))) ) (defun deltay (pt1 pt2) (- (fix (cadr pt1)) (fix (cadr pt2))) ) (defun make4points (pointslist / cpt cptbefore cptafter returnlist) (setq cpt 0) (setq returnlist '()) (repeat (length pointslist) (setq cptbefore (- cpt 1)) (if (< cptbefore 0) (setq cptbefore (- (length pointslist) 1)) ) (setq cptafter (+ cpt 1)) (if (> cptafter (- (length pointslist) 1)) (setq cptafter 0) ) (print) (princ cptbefore) (princ cpt) (princ cptafter) (print) (if (and (/= (deltax (nth cptbefore pointslist) (nth cpt pointslist)) (deltax (nth cpt pointslist) (nth cptafter pointslist)) ) (/= (deltay (nth cptbefore pointslist) (nth cpt pointslist)) (deltay (nth cpt pointslist) (nth cptafter pointslist)) ) ) (setq returnlist (append returnlist (list (nth cpt pointslist)))) ) (setq cpt (+ cpt 1)) (if (= cpt (length pointslist)) (setq cpt 0) ) ) returnlist ) ;; ------------------------------------------------------- ;;; coloring rectangles ;; ------------------------------------------------------- (defun c:paint () (paint_rectangles) ) (defun paint_rectangles (/ colorList colorIndex layerNumber index temp numObjects pickColor ) (setq colorList '(1 5 2 255 254 253 252 251 250)) (setq colorIndex 0) (setq layerNumber 1) (while (<= layerNumber *holdLayerNumber*) (setq temp (itoa layerNumber)) ; converts integer to string (print "temp=") (print temp) ;;; (setq ss (ssget "_X" '((-4 . "")))) (setq ss (ssget "_X" (list (cons 8 temp) ))) ;; (0 . "LWPOLYLINE") ; create sel set with objects on first layer (print ss) (print "Number of objects on this layer = ") (princ numObjects) (if ss (setq numObjects (sslength ss)) (setq numObjects 0) ) (setq index 0) (repeat numObjects (command "region" (ssname ss index) "") ;; make entity region by picking it (setq regionObject (entlast)) (setq colorIndex (rand 0 8)) ;; grab random item from colorList ??? (setq pickColor (nth colorIndex colorList)) (print "the picked color number is=") (print pickColor) (command "chprop" regionObject "" "c" pickColor "") (setq index (+ index 1)) (print "index=") (print index) ) ; close repeat (setq layerNumber (+ layerNumber 1)) ) ; close while ) ; close defun (setq *SeedRand* nil) ; initialize the global ;;;;; random functions from takehiko nagakura ;;;;; (rand16) : generates a random number between 1 and 32767, ;;;;; that is, a positive 16 bit integer(defun rand16 ( / s ) ;;;;; (defun rand16 ( / s ) ; when this is used for the first time, initialize the seed ; from the system clock. (if (null *SeedRand*) (progn (setq s (getvar "date")) (setq *SeedRand* (fix (* 86400 (- s (fix s))))) ) ; progn ) ; if (setq *SeedRand* (+ (* *SeedRand* 1103515245) 12345)) ; trim off the bits left of the 16th bits (logand (/ *SeedRand* 65536) 32767) );_ end of rand16` ;;; generates a random number between min and max. ;;; min and max must be a non-negative integer smaller than 32678. (defun rand (min max / r16 range quotient remainder result) (setq r16 (rand16)) ; random number smaller than 32678 (setq range (+ 1 (- max min))) ; number of integers to be produced (setq quotient (/ r16 range)) ; result in non-neg. integer (setq remainder (- r16 (* quotient range))) (setq result (+ min remainder)) result );_ end of rand ;; ---------------------------------------------------------------------- ;; function that make small wedges inside the big wedges of the rectangle ;; ---------------------------------------------------------------------- (defun small_wedge (*wedge* / theWedge howManyPoints the4points p1 p2 p3 p4 myDist wedgeThickness ) (print "in the small wedge function") (setq index 0) (setq numObjects 4) (print "numObjects = 4") (print (entity_to_points (ssname thislayer_ss index))) (print "got here ins small wedge func") (repeat numObjects (setq theWedge (entity_to_points (ssname thislayer_ss index))) (print "theWedge Wedge Points=") (print theWedge) (setq howManyPoints (length theWedge)) (print "Number of all Rect Points=") (print howManyPoints) (setq the4points (make4points theWedge)) (print "the 4 points are: ") (print the4points) (setq p1 (nth 0 the4points)) ;w1p1 = wedge 1, point 1 (print "p1=") (print p1) (setq p2 (nth 1 the4points)) (print "p2=") (print p2) (setq p3 (nth 2 the4points)) (print "p3=") (print p3) (setq p4 (nth 3 the4points)) (print "p4=") (print p4) ;; fixed/rounded coordinate values need for the next check (setq p1temp (fix (car p1))) (print "p1temp") (print p1temp) (setq p2temp (fix (car p2))) (print "p2temp") (print p2temp) (setq p3temp (fix (car p3))) (print "p3temp") (print p3temp) (setq p4temp (fix (car p4))) (print "p4temp") (print p4temp) ;;; if p1 and p4 X values are same, and p2 and p3 X values are the same, myDist is p1p2 else p1p4 (if (and (= p4temp p1temp) (= p2temp p3temp)) ;; if p1 and p4 x values are same, do this: (progn ;; check which one has bigger value and (setq myDist (abs (distance p1 p2))) ;; find Y distance between first and last points (print "myDist = ") (print myDist) (print "i am in the first part of the if") (setq wedgeThickness (/ myDist 8.0)) (print "wedgeThickness=") (print wedgeThickness) ;; wedge thickness is 10th of distance (setq halfDist (/ myDist 2.0)) (print "half wedgeThickness=") (print halfDist) ;; 1 = wedge on short side of rectangle, 2 = wedge on long side (if (= *wedge* 1) (progn (print "short wedge") (if (and (> (abs (distance p1 p4)) (abs (distance p2 p3)))) (setq myPoint (list (+ (car p2) wedgeThickness) (cadr (inters p1 p3 p2 p4)))) (setq myPoint (list (- (car p1) wedgeThickness) (cadr (inters p1 p3 p2 p4)))) ) ; close if ) ; close progn (progn (print "long wedge") (if (and (> (abs (distance p1 p2)) (abs (distance p3 p4)))) (setq myPoint (list (- (car p1) wedgeThickness) (cadr (inters p1 p3 p2 p4)))) (setq myPoint (list (+ (car p2) wedgeThickness) (cadr (inters p1 p3 p2 p4)))) ) ; close if ) ; close progn ) ; close (if (*wedge* 1) (setq xLine_direction "v") (print "direction of constr line is vertical") ) ; close progn (setq myDis . . . (progn (setq myDist (abs (distance p1 p4))) (print "myDist = ") (print myDist) (print "i am in the second part of the if") (setq wedgeThickness (/ myDist 6.0)) (print "wedgeThickness=") (print wedgeThickness) ;; wedge thickness is 10th of distance (setq halfDist (/ myDist 2.0)) (print "half dist=") (print halfDist) (if (= *wedge* 1) ;; and if wedge request is for small side (progn (print "short wedge") (if (and (> (abs (distance p1 p2)) (abs (distance p3 p4)))) (setq myPoint (list (car (inters p1 p3 p2 p4)) (+ (cadr p4) wedgeThickness) ) ) (setq myPoint (list (car (inters p1 p3 p2 p4)) (- (cadr p1) wedgeThickness) ) ) ) ; close if ) ; close progn (progn (print "long wedge") (print myPoint) (if (and (> (abs (distance p1 p2)) (abs (distance p3 p4)))) (setq myPoint (list (car (inters p1 p3 p2 p4)) (- (cadr p1) wedgeThickness) ) ) (setq myPoint (list (car (inters p1 p3 p2 p4)) (+ (cadr p4) wedgeThickness) ) ) ) ; close if ) ; close progn ) ; close (if (*wedge* 1) (setq xLine_direction "h") (print "direction of constr line is horizontal") ) ; close progn (setq myDis . . . ) ; close if (print "myPoint is=") (print myPoint) (command "bpoly" myPoint "") (print "created bpoly . . . ") (setq thisPoly (entlast)) (print "setq thisPoly . . . ") (setq thisPoly (entity_to_points thisPoly)) (print "entity_to_points thisPoly . . . ") (setq pt1 (nth 0 thisPoly)) (print pt1) (setq pt2 (nth 1 thisPoly)) (print pt2) (setq pt3 (nth 2 thisPoly)) (print pt3) (setq pt4 (nth 3 thisPoly)) (print pt4) (setq tempPolyPTS (length thisPoly)) (print "Number of tempPoly points=") (print tempPolyPTS) (command "erase" thisPoly "") (print "deleting the thisPoly object . . . ") (setq orientation xLine_direction) (print "cons line orientation = ") (print orientation) ;; horizontal or vertical direction of constr line (command "xline" orientation myPoint "") (print "first cons line drawn") (setq thisLine (entlast)) (print "myPoint is=") (print myPoint) (setq firstThruPT (list (+ (car myPoint) 2.0) (+ (cadr myPoint) 2.0))) (print "firstThruPT") (print firstThruPT) ;(command "point" firstThruPT "") (command "bpoly" firstThruPT "") (setq thisPoly (entlast)) (command "move" thisPoly "" (list 0 0 0) (list 0 0 1)) (print "first wedge done . . . ") (setq secondThruPT (list (- (car myPoint) 2.0) (- (cadr myPoint) 2.0))) (print "secondThruPT") (print secondThruPT) ;(command "point" secondThruPT "") (command "bpoly" secondThruPT "") (setq thisPoly (entlast)) (command "move" thisPoly "" (list 0 0 0) (list 0 0 1)) (print "second wedge done . . . ") (command "erase" thisLine "") (setq index (+ index 1)) (print "index=") (print index) ) ; close repeat ;;;(command "erase" firstPoly secondPoly thirdPoly fourthPoly "") (setq thislayer_ss nil) ) ; close defun (command "render" "")