; The Codewriting Workbook ; Creating Computational Architecture in AutoLISP ; by Robert J. Krawczyk ; Princeton Architectural Press, 2008 ; -------------------------------------------------------------------------- ; CH07A.LSP ; -------------------------------------------------------------------------- ; Disclaimer: The information contained in this file is distributed on an ; "as is" basis, without warranty. Although every precaution has been taken ; in the preparation of this work, the author and publisher shall not have ; any liability to any person or entity with respect to any loss or damage ; caused or alleged to be caused directly or indirectly by the information ; contained in this work. ; -------------------------------------------------------------------------- (defun dtr (a) (* pi (/ a 180.0))) (defun rtd (a) (/ (* a 180.0) pi)) ;--------------------------------------------------------------------------- (defun rn (/ modulus multiplier increment random) (if (not rnseed) (setq rnseed (getvar "DATE"))) (setq modulus 65536 multiplier 25173 increment 13849 rnseed (rem (+ (* multiplier rnseed) increment) modulus) random (/ rnseed modulus) ) ) ;--------------------------------------------------------------------------- ;Rounding, round x to ndec decimals: (defun round (x ndec) (atof (rtos x 2 ndec))) ;--------------------------------------------------------------------------- ; VT - top view (defun c:vt () (command "vpoint" "r" 270 90) (command "zoom" "e" "ucs" "v" "zoom" ".9x") (princ) ) ; VL - left view (defun c:vl () (command "vpoint" "r" 180 0) (command "zoom" "e" "ucs" "v" "zoom" ".9x") (princ) ) ; VR - right view (defun c:vr () (command "vpoint" "r" 0 0) (command "zoom" "e" "ucs" "v" "zoom" ".9x") (princ) ) ; VF - front view (defun c:vf () (command "vpoint" "r" 270 0) (command "zoom" "e" "ucs" "v" "zoom" ".9x") (princ) ) ; VB - back view (defun c:vb () (command "vpoint" "r" 90 0) (command "zoom" "e" "ucs" "v" "zoom" ".9x") (princ) ) ; VSW - SW view (defun c:vsw () (command "vpoint" "r" 270 90) (command "ucs" "v") (command "vpoint" "r" 225 45) (command "zoom" "e" "zoom" ".9x") (princ) ) ; VSE - SE view (defun c:vse () (command "vpoint" "r" 270 90) (command "ucs" "v") (command "vpoint" "r" 315 45) (command "zoom" "e" "zoom" ".9x") (princ) ) ; VNE - NE view (defun c:vne () (command "vpoint" "r" 270 90) (command "ucs" "v") (command "vpoint" "r" 45 45) (command "zoom" "e" "zoom" ".9x") (princ) ) ; VNW - NW view (defun c:vnw () (command "vpoint" "r" 270 90) (command "ucs" "v") (command "vpoint" "r" 135 45) (command "zoom" "e" "zoom" ".9x") (princ) ) ;--------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog01 () ; file to read (setq fh1 (open "C:\\TMY2_data\\94846.tm2" "r")) (while fh1 (setq nline (read-line fh1)) (if nline (progn (princ "\n")(princ nline) ) (setq fh1 (close fh1)) ) ) (textscr) (princ) ) ; --------------------------------------------------------------------------- (defun prog01a () ; file to read (setq fh1 (open "C:\\TMY2_data\\94846.tm2" "r")) (while fh1 (setq nline (read-line fh1)) (if nline (progn ; 004 - 005 Month, 1-12 (princ (atoi (substr nline 4 2))) (princ " ") ; 006 - 007 Day, 1-31 (princ (atoi (substr nline 6 2))) (princ " ") ; 008 - 009 Hour, 1-24 (princ (atoi (substr nline 8 2))) (princ " ") ; 068 - 071 Dry bulb temperature in tenths of degrees Celsius (princ (/ (atof (substr nline 68 4)) 10.0)) (princ " ") ; 074 - 077 Dew point temperature in tenths of Celisue (princ (/ (atof (substr nline 74 4)) 10.0)) (princ " ") ; 080 - 082 Relative humidity in percent (princ (atoi (substr nline 80 3))) (princ " ") ; 085 - 088 Atmospheric pressure at station in millibars (princ (atoi (substr nline 85 4))) (princ " ") ; 091 - 093 Wind direction in degrees, 0-360 (princ (atoi (substr nline 91 3))) (princ " ") ; 096 - 098 Wind speed in tenths of meters per second (princ (/ (atof (substr nline 96 3)) 10.0)) (princ " ") ; 124 - 126 Precipitable water in millimeters (princ (atoi (substr nline 124 3))) (princ " ") ; 134 - 136 Snow depth in centimeters (princ (atoi (substr nline 134 3))) (princ "\n") ) (setq fh1 (close fh1)) ) ) (textscr) (princ) ) ; --------------------------------------------------------------------------- (defun prog01b () ; file to write (setq fh2 (open "C:\\TMY2_data\\Chicago.txt" "w")) ; file to read (setq fh1 (open "C:\\TMY2_data\\94846.tm2" "r")) ; read first line and ignore (if (/= fh1) (setq nline (read-line fh1))) (while fh1 (setq nline (read-line fh1)) (if nline (progn ; 004 - 005 Month, 1-12 (princ (atoi (substr nline 4 2)) fh2) (princ " " fh2) ; 006 - 007 Day, 1-31 (princ (atoi (substr nline 6 2)) fh2) (princ " " fh2) ; 008 - 009 Hour, 1-24 (princ (atoi (substr nline 8 2)) fh2) (princ " " fh2) ; 068 - 071 Dry bulb temperature in tenths of degrees Celsius ; to Fahrenheit (setq val (+ (/ (* (/ (atof (substr nline 68 4)) 10.0) 9.0) 5.0) 32)) (princ val fh2) (princ " " fh2) ; 074 - 077 Dew point temperature in tenths of Celisue ; to Fahrenheit (setq val (+ (/ (* (/ (atof (substr nline 74 4)) 10.0) 9.0) 5.0) 32)) (princ val fh2) (princ " " fh2) ; 080 - 082 Relative humidity in percent (princ (atoi (substr nline 80 3)) fh2) (princ " " fh2) ; 085 - 088 Atmospheric pressure at station in millibars (princ (atoi (substr nline 85 4)) fh2) (princ " " fh2) ; 091 - 093 Wind direction in degrees, 0-360 (princ (atoi (substr nline 91 3)) fh2) (princ " " fh2) ; 096 - 098 Wind speed in tenths of meters per second ; to miles/hr (setq val (* (/ (atof (substr nline 96 3)) 10.0) 2.236)) (princ val fh2) (princ " " fh2) ; 124 - 126 Precipitable water in millimeters ; to inches (setq val (* (atoi (substr nline 124 3)) 0.03937)) (princ val fh2) (princ " " fh2) ; 134 - 136 Snow depth in centimeters ; to inches (setq val (* (atoi (substr nline 134 3)) 0.3937)) (princ val fh2) (princ "\n" fh2) ) (setq fh1 (close fh1)) ) ) (setq fh2 (close fh2)) (princ) ) ; --------------------------------------------------------------------------- (defun prog01c () ; file to write (setq fh2 (open "C:\\TMY2_data\\ChicagoAvgTemps.txt" "w")) ; file to read (setq fh1 (open "C:\\TMY2_data\\94846.tm2" "r")) ; set total temp (setq totaltemp 0.0) ; set high/low temp (setq hightemp -9999.0) (setq lowtemp 9999.0) ; read first line and ignore (if (/= fh1) (setq nline (read-line fh1))) (while fh1 (setq nline (read-line fh1)) (if nline (progn ; 004 - 005 Month, 1-12 (setq nmonth (atoi (substr nline 4 2))) ; 006 - 007 Day, 1-31 (setq nday (atoi (substr nline 6 2))) ; 008 - 009 Hour, 1-24 (setq nhour (atoi (substr nline 8 2))) ; 068 - 071 Dry bulb temperature in tenths of degrees Celsius ; to Fahrenheit (setq tempval (+ (/ (* (/ (atof (substr nline 68 4)) 10.0) 9.0) 5.0) 32)) ; acum temp (setq totaltemp (+ totaltemp tempval)) ; check temp (if (> tempval hightemp) (setq hightemp tempval)) (if (< tempval lowtemp) (setq lowtemp tempval)) ; check hour (if (= nhour 24) (progn ; compute average (setq avgtemp (/ totaltemp 24)) ; write to file (princ nmonth fh2) (princ " " fh2) (princ nday fh2) (princ " " fh2) (princ avgtemp fh2) (princ " " fh2) (princ lowtemp fh2) (princ " " fh2) (princ hightemp fh2) (princ "\n" fh2) ; reset total temp (setq totaltemp 0.0) ; reset high/low temp (setq hightemp -9999.0) (setq lowtemp 9999.0) )) ) (setq fh1 (close fh1)) ) ) (setq fh2 (close fh2)) (princ) ) ; --------------------------------------------------------------------------- (defun prog01d () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago.txt" "r")) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (princ "\n") (princ datalist) ) (setq fh1 (close fh1)) ) ) (textscr) (princ) ) ; --------------------------------------------------------------------------- (defun prog02 () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; start mesh (command ".3DMESH" "31" "24") (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) ; add pt to mesh (setq pt (list (nth 1 datalist) (nth 2 datalist) (* (nth 3 datalist) 0.1))) (command pt) ) (setq fh1 (close fh1)) ) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- (defun prog02a () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago.txt" "r")) ; months (setq months (list 0 31 28 31 30 31 30 31 31 30 31 30 31)) (setq nday 1) (setq nmonth 1) (repeat 12 (setq ndays (nth nmonth months)) (command ".3DMESH" (+ ndays 2) "24") ; add first pts in month (setq nhour 1) (repeat 24 (command (list (* nday 0.025) nhour 0.0)) (setq nhour (+ nhour 1)) ) (setq nday (+ nday 1)) (repeat ndays (repeat 24 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (* nday 0.025) (nth 2 datalist) (* (nth 3 datalist) 0.075) )) (command pt) (setq nday (+ nday 1)) ) (setq fh1 (close fh1)) ) ) ) ; add last pts in month (setq nhour 1) (repeat 24 (command (list (* nday 0.025) nhour 0.0)) (setq nhour (+ nhour 1)) ) (setq nday (+ nday 1)) ; inc month (setq nmonth (+ nmonth 1)) ) ; rotate to vertical (command ".ROTATE3D" "all" "" "x" "0,0,0" "90") (princ) ) ; --------------------------------------------------------------------------- (defun prog02b () (setq zscale (getdist "\nEnter Z scale: ")) (setq zmin (getdist "\nEnter minimum Z value: ")) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; start mesh (command ".3DMESH" (+ 31 2) (+ 24 3)) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq nday (nth 1 datalist)) (setq nhour (nth 2 datalist)) ; add pt to mesh (setq pt (list nday nhour (+ (* (nth 3 datalist) zscale) zmin))) ; check for first edge (if (and (= nday 1) (= nhour 1)) (progn (setq ihour 1) (command (list nday ihour 0)) (repeat 24 (command (list nday ihour 0)) (setq ihour (+ ihour 1)) ) (command (list nday 24 0)) (command (list nday 1 0)) )) ; save first pt (if (= nhour 1) (progn (setq fpt (list nday nhour 0)) (command fpt) )) (command pt) ; add first pt (if (= nhour 24) (progn (command (list nday nhour 0)) (command fpt) )) ; check for last edge (if (and (= nday 31) (= nhour 24)) (progn (setq ihour 1) (command (list nday ihour 0)) (repeat 24 (command (list nday ihour 0)) (setq ihour (+ ihour 1)) ) (command (list nday 24 0)) (command (list nday 1 0)) )) ) (setq fh1 (close fh1)) ) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog02c () (setq zscale (getdist "\nEnter Z scale: ")) (setq zmin (getdist "\nEnter minimum Z value: ")) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; start mesh (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) ; add pt to section (setq pt (list (nth 1 datalist) (nth 2 datalist) (+ (* (nth 3 datalist) zscale) zmin))) ; start (if (= (nth 2 datalist) 1) (command ".3DPOLY" (list (nth 1 datalist) (nth 2 datalist) 0))) (command pt) (if (= (nth 2 datalist) 24) (progn (command (list (nth 1 datalist) (nth 2 datalist) 0) "c") (command ".ZOOM" "e") (command ".REGION" "last" "") )) ) (setq fh1 (close fh1)) ) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog03 () (setq xyscale (getdist "\nEnter XY scale: ")) (setq zscale (getdist "\nEnter Z scale: ")) (setq zmin (getdist "\nEnter minimum Z value: ")) ; selection list (setq llist (ssadd)) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) ; construct cube at pt (setq nday (nth 1 datalist)) (setq xpt (* nday xyscale)) (setq nhour (nth 2 datalist)) (setq ypt (* nhour xyscale)) (setq ntemp (nth 3 datalist)) (setq zpt (+ (* ntemp zscale) zmin)) ; center pt (setq pntc (list xpt ypt 0.0)) ; draw polygon (command ".POLYGON" "4" pntc "C" (/ xyscale 2.0)) ;(command ".ZOOM" "e") (command ".EXTRUDE" "last" "" zpt) ; add to list (setq llist (ssadd (entlast) llist)) ; versions prior to 2007 require the taper parameter ;(command ".EXTRUDE" "last" "" zpt "") ; check if day completed (if (= nhour 24) (progn (command ".UNION" llist "") (setq llist (ssadd)) )) ) (setq fh1 (close fh1)) ) ) (command ".ZOOM" "e") (command ".BREP" "all" "") (command ".UNION" "all" "") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog04 () (setq xyscale (getdist "\nEnter XY scale: ")) (setq cmin (getdist "\nEnter minimum radius percent: ")) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; min/max (setq hightemp -9999.0) (setq lowtemp 9999.0) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq ntemp (nth 3 datalist)) ; check min/max (if (> ntemp hightemp) (setq hightemp ntemp)) (if (< ntemp lowtemp) (setq lowtemp ntemp)) ) (setq fh1 (close fh1)) ) ) ; temp diff (setq difftemp (- hightemp lowtemp)) ; min radius (setq minrad (* (/ xyscale 2.0) cmin)) ; radius diff (setq raddiff (- (* (/ xyscale 2.0) 0.90) minrad)) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) ; construct circle at pt (setq nday (nth 1 datalist)) (setq xpt (* nday xyscale)) (setq nhour (nth 2 datalist)) (setq ypt (* nhour xyscale)) (setq ntemp (nth 3 datalist)) ; compute radius (setq crad (+ minrad (* (/ (abs (- lowtemp ntemp)) difftemp) raddiff))) ; center pt (setq pntc (list xpt ypt 0.0)) ; draw circle (command ".CIRCLE" pntc crad) (command ".ZOOM" "e") ) (setq fh1 (close fh1)) ) ) ; boundary (setq pnt0 (list (/ xyscale 2.0) (/ xyscale 2.0) 0)) (setq pnt1 (list (+ (nth 0 pnt0) (* 31 xyscale)) (+ (nth 1 pnt0) (* 24 xyscale)) 0)) (command ".RECTANGLE" pnt0 pnt1) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog04a () (setq xyscale (getdist "\nEnter XY scale: ")) (setq cmin (getdist "\nEnter minimum radius percent: ")) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; min/max (setq hightemp -9999.0) (setq lowtemp 9999.0) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq ntemp (nth 3 datalist)) ; check min/max (if (> ntemp hightemp) (setq hightemp ntemp)) (if (< ntemp lowtemp) (setq lowtemp ntemp)) (setq pt (list (nth 1 datalist) (nth 2 datalist) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; temp diff (setq difftemp (- hightemp lowtemp)) ; min radius (setq minrad (* (/ xyscale 2.0) cmin)) ; radius diff (setq raddiff (- (* (/ xyscale 2.0) 0.90) minrad)) ; list counter (setq cnt 0) (repeat (length plist) ; construct circle at pt (setq nday (nth 0 (nth cnt plist))) (setq xpt (* nday xyscale)) (setq nhour (nth 1 (nth cnt plist))) (setq ypt (* nhour xyscale)) (setq ntemp (nth 2 (nth cnt plist))) ; compute radius (setq crad (+ minrad (* (/ (abs (- lowtemp ntemp)) difftemp) raddiff))) ; center pt (setq pntc (list xpt ypt 0.0)) ; draw circle (command ".CIRCLE" pntc crad) (command ".ZOOM" "e") ; next pos in list (setq cnt (+ cnt 1)) ) ; boundary (setq pnt0 (list (/ xyscale 2.0) (/ xyscale 2.0) 0)) (setq pnt1 (list (+ (nth 0 pnt0) (* 31 xyscale)) (+ (nth 1 pnt0) (* 24 xyscale)) 0)) (command ".RECTANGLE" pnt0 pnt1) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog04b () (setq xyscale (getdist "\nEnter XY scale: ")) (setq cmin (getdist "\nEnter minimum radius percent: ")) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; min/max (setq highspeed -9999.0) (setq lowspeed 9999.0) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq nspeed (nth 8 datalist)) ; check min/max (if (> nspeed highspeed) (setq highspeed nspeed)) (if (< nspeed lowspeed) (setq lowspeed nspeed)) (setq pt (list (nth 1 datalist) (nth 2 datalist) (nth 7 datalist) (nth 8 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; temp diff (setq diffspeed (- highspeed lowspeed)) ; min radius (setq minrad (* (/ xyscale 2.0) cmin)) ; radius diff (setq raddiff (- (* (/ xyscale 2.0) 0.90) minrad)) ; list counter (setq cnt 0) (repeat (length plist) ; construct circle at pt (setq nday (nth 0 (nth cnt plist))) (setq xpt (* nday xyscale)) (setq nhour (nth 1 (nth cnt plist))) (setq ypt (* nhour xyscale)) (setq ndir (nth 2 (nth cnt plist))) (setq nspeed (nth 3 (nth cnt plist))) ; compute radius (setq crad (+ minrad (* (/ (abs (- lowspeed nspeed)) diffspeed) raddiff))) ; center pt (setq pntc (list xpt ypt 0.0)) ; draw triangle (command ".POLYGON" "3" pntc "i" crad) (command ".ZOOM" "e") ; rotate triangle (setq rotang (* ndir -1)) (command ".ROTATE" "last" "" pntc rotang) ; add marker (setq cpt (polar pntc (dtr (+ rotang 90)) crad)) (command ".CIRCLE" cpt (* crad 0.15)) ; next pos in list (setq cnt (+ cnt 1)) ) ; boundary (setq pnt0 (list (/ xyscale 2.0) (/ xyscale 2.0) 0)) (setq pnt1 (list (+ (nth 0 pnt0) (* 31 xyscale)) (+ (nth 1 pnt0) (* 24 xyscale)) 0)) (command ".RECTANGLE" pnt0 pnt1) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog05 () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; radius and angle inc based on 24 hours (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) ; start mesh (command ".3DMESH" "31" "24") (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) ; radius is hours plus temperature (setq xpt (* (+ rad (* (nth 3 datalist) 0.075)) (cos (dtr (* anginc (nth 2 datalist)))))) (setq ypt (* (+ rad (* (nth 3 datalist) 0.0751)) (sin (dtr (* anginc (nth 2 datalist)))))) ; height is day (setq zpt (- (nth 1 datalist) 1)) (setq pt (list xpt ypt zpt)) (command pt) ) (setq fh1 (close fh1)) ) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- (defun prog05a () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; radius and angle inc based on 24 hours (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) ; start mesh (command ".3DMESH" "31" (+ 24 1)) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) ; radius is hours plus temperature (setq xpt (* (+ rad (* (nth 3 datalist) 0.075)) (cos (dtr (* anginc (nth 2 datalist)))))) (setq ypt (* (+ rad (* (nth 3 datalist) 0.075)) (sin (dtr (* anginc (nth 2 datalist)))))) ; height is day (setq zpt (- (nth 1 datalist) 1)) (setq pt (list xpt ypt zpt)) ; save first pt (if (= (nth 2 datalist) 1) (setq fpt pt)) (command pt) ; close mesh (if (= (nth 2 datalist) 24) (command fpt)) ) (setq fh1 (close fh1)) ) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- (defun prog05b () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; radius and angle inc based on 24 hours (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) ; start mesh (command ".3DMESH" (+ 31 2) (+ 24 1)) ; bottom (repeat (+ 24 1) (command (list 0 0 0)) ) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) ; radius is hours plus temperature (setq xpt (* (+ rad (* (nth 3 datalist) 0.075)) (cos (dtr (* anginc (nth 2 datalist)))))) (setq ypt (* (+ rad (* (nth 3 datalist) 0.075)) (sin (dtr (* anginc (nth 2 datalist)))))) ; height is day (setq zpt (- (nth 1 datalist) 1)) (setq pt (list xpt ypt zpt)) ; save first pt (if (= (nth 2 datalist) 1) (setq fpt pt)) (command pt) ; close mesh (if (= (nth 2 datalist) 24) (command fpt)) ) (setq fh1 (close fh1)) ) ) ; top (repeat (+ 24 1) (command (list 0 0 zpt)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog05c () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; radius and angle inc based on 24 hours (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) ; radius is hours plus temperature (setq xpt (* (+ rad (* (nth 3 datalist) 0.075)) (cos (dtr (* anginc (nth 2 datalist)))))) (setq ypt (* (+ rad (* (nth 3 datalist) 0.075)) (sin (dtr (* anginc (nth 2 datalist)))))) ; height is day (setq zpt (- (nth 1 datalist) 1)) (setq pt (list xpt ypt zpt)) ; first pt (if (= (nth 2 datalist) 1) (command ".3DPOLY")) (command pt) ; close polyline (if (= (nth 2 datalist) 24) (progn (command "c") (command ".ZOOM" "e") (command ".REGION" "last" "") )) ) (setq fh1 (close fh1)) ) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog05d () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; radius and angle inc based on 24 hours (setq rad (/ 31.0 (* 2 pi))) (setq anginc (/ 360.0 31)) ; start mesh (command ".3DMESH" (+ 24 2) (+ 31 1)) ; bottom (repeat (+ 31 1) (command (list 0 0 0)) ) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) ; radius is day plus temperature (setq xpt (* (+ rad (* ntemp 0.075)) (cos (dtr (* anginc dcnt))))) (setq ypt (* (+ rad (* ntemp 0.075)) (sin (dtr (* anginc dcnt))))) ; height is hour (setq zpt (- hcnt 1)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) ; top (repeat (+ 31 1) (command (list 0 0 zpt)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- (defun prog05e () (setq zheight (getdist "\nEnter height: ")) (setq cradmin (getdist "\nEnter min radius: ")) (setq cradmax (getdist "\nEnter max radius: ")) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) ; min/max temp (setq tmin 9999.0) (setq tmax -9999.0) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ; check for min/max (if (> (nth 3 datalist) tmax) (setq tmax (nth 3 datalist))) (if (< (nth 3 datalist) tmin) (setq tmin (nth 3 datalist))) ) (setq fh1 (close fh1)) ) ) ; height scale (setq hscale (/ zheight (- 24 1))) ; radius (setq tscale (/ (- cradmax cradmin) (- tmax tmin))) ; radius and angle inc based on 31 days (setq anginc (/ 360.0 31)) ; start mesh (command ".3DMESH" (+ 24 2) (+ 31 1)) ; bottom (repeat (+ 31 1) (command (list 0 0 0)) ) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) ; radius is day plus temperature (setq xpt (* (+ cradmin (* (abs (- tmin ntemp)) tscale)) (cos (dtr (* anginc dcnt))))) (setq ypt (* (+ cradmin (* (abs (- tmin ntemp)) tscale)) (sin (dtr (* anginc dcnt))))) ; height is hour (setq zpt (* (- hcnt 1) hscale)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) ; top (repeat (+ 31 1) (command (list 0 0 zpt)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog06 () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; radius and angle inc based on 24 hours (setq rad (/ 31.0 (* 2 pi))) (setq anginc (/ 360.0 31)) ; start mesh (command ".3DMESH" (+ 24 0) (+ 31 1)) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) ; radius is hours (setq xpt (* hcnt (cos (dtr (* anginc dcnt))))) (setq ypt (* hcnt (sin (dtr (* anginc dcnt))))) ; height is temperature (setq zpt (* ntemp 0.1)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog06a () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; radius and angle inc based on 24 hours (setq rad (/ 31.0 (* 2 pi))) (setq anginc (/ 360.0 31)) ; center offset (setq coff 4.0) ; start mesh (command ".3DMESH" (+ 24 0) (+ 31 1)) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) ; radius is hours (setq xpt (* (+ hcnt coff) (cos (dtr (* anginc dcnt))))) (setq ypt (* (+ hcnt coff) (sin (dtr (* anginc dcnt))))) ; height is temperature (setq zpt (* ntemp 0.1)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- (defun prog06b () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; radius and angle inc based on 24 hours (setq rad (/ 31.0 (* 2 pi))) (setq anginc (/ 360.0 31)) ; center offset (setq coff 6.0) ; start mesh (command ".3DMESH" (+ 24 1) (+ 31 1)) ; center (repeat (+ 31 1) (command (list 0 0 0)) ) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) ; radius is hours (setq xpt (* (+ hcnt coff) (cos (dtr (* anginc dcnt))))) (setq ypt (* (+ hcnt coff) (sin (dtr (* anginc dcnt))))) ; height is temperature (setq zpt (* ntemp 0.1)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog06c () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; radius and angle inc based on 24 hours (setq rad (/ 31.0 (* 2 pi))) (setq anginc (/ 360.0 31)) ; center offset (setq coff 6.0) ; start mesh (command ".3DMESH" (+ 24 1) (+ 31 1)) ; center (repeat (+ 31 1) (command (list 0 0 0)) ) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) ; radius is hours (setq xpt (* (* (+ hcnt coff) 1.50) (cos (dtr (* anginc dcnt))))) (setq ypt (* (+ hcnt coff) (sin (dtr (* anginc dcnt))))) ; height is temperature (setq zpt (* ntemp 0.1)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- (defun prog06d () (setq zscale (getdist "\nEnter Z scale: ")) (setq zmin (getdist "\nEnter minimum Z value: ")) ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; radius and angle inc based on 24 hours (setq rad (/ 31.0 (* 2 pi))) (setq anginc (/ 360.0 31)) ; center offset (setq coff 6.0) ; start mesh (command ".3DMESH" (+ 24 3) (+ 31 1)) ; center (repeat (+ 31 1) (command (list 0 0 zmin)) ) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) ; radius is hours (setq xpt (* (+ hcnt coff) (cos (dtr (* anginc dcnt))))) (setq ypt (* (+ hcnt coff) (sin (dtr (* anginc dcnt))))) ; height is temperature (setq zpt (+ (* ntemp zscale) zmin)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) ; edge (setq dcnt 1) (repeat 31 (setq xpt (* (+ 24 coff) (cos (dtr (* anginc dcnt))))) (setq ypt (* (+ 24 coff) (sin (dtr (* anginc dcnt))))) (setq pt (list xpt ypt 0)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) (setq dcnt (+ dcnt 1)) ) ; bottom (repeat (+ 31 1) (command (list 0 0 0)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- (defun prog07 () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; radius and angle inc based on 24 hours (setq hrad (/ 24.0 (* 2 pi))) (setq hanginc (/ 90.0 24)) (setq drad (/ 31.0 (* 2 pi))) (setq danginc (/ 360.0 31)) ; start mesh (command ".3DMESH" (+ 24 0) (+ 31 1)) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* (* (+ drad (* ntemp 0.075)) (cos (dtr (* danginc dcnt)))) (sin (dtr (* hanginc hcnt))))) (setq ypt (* (* (+ drad (* ntemp 0.075)) (sin (dtr (* danginc dcnt)))) (sin (dtr (* hanginc hcnt))))) (setq zpt (* hrad (cos (dtr (* hanginc hcnt))))) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- (defun prog07a () ; file to read (setq fh1 (open "C:\\TMY2_data\\Chicago01.txt" "r")) ; set list (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq datalist (read (strcat "(" nline ")"))) (setq pt (list (list (nth 1 datalist) (nth 2 datalist)) (nth 3 datalist))) ; add pt to list (setq plist (append plist (list pt))) ) (setq fh1 (close fh1)) ) ) ; radius and angle inc based on 24 hours (setq openang 20) (setq hrad (/ 24.0 (* 2 pi))) (setq hanginc (/ (- 180.0 openang) 24)) (setq drad (/ 31.0 (* 2 pi))) (setq danginc (/ 360.0 31)) ; start mesh (command ".3DMESH" (+ 24 0) (+ 31 1)) ; hour count (setq hcnt 1) (repeat 24 ; day count (setq dcnt 1) (repeat 31 ; get temperature (setq ntemp (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* (* (+ drad (* ntemp 0.075)) (cos (dtr (* danginc dcnt)))) (sin (dtr (+ (* hanginc hcnt) openang))))) (setq ypt (* (* (+ drad (* ntemp 0.075)) (sin (dtr (* danginc dcnt)))) (sin (dtr (+ (* hanginc hcnt) openang))))) (setq zpt (* hrad (cos (dtr (+ (* hanginc hcnt) openang))))) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) ; inc day (setq dcnt (+ dcnt 1)) ) ; inc hour (setq hcnt (+ hcnt 1)) ) (command ".ZOOM" "e") (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog08 () (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) ; radius and angle inc based on 24 hours (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) (command ".3DMESH" "31" "24") (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) ; radius is hours plus temperature (setq xpt (* (+ rad (* (nth 4 doelist) 0.1)) (cos (dtr (* anginc (nth 2 doelist)))))) (setq ypt (* (+ rad (* (nth 4 doelist) 0.1)) (sin (dtr (* anginc (nth 2 doelist)))))) ; height is day (setq zpt (nth 1 doelist)) (setq pt (list xpt ypt zpt)) (command pt) ) (setq fh1 (close fh1)) ) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog09 () (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq rscale 0.5) (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) (command ".3DMESH" "31" "25") (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) ; radius is hours plus temperature (setq xpt (* (* (+ rad (* (nth 4 doelist) 0.1)) rscale) (cos (dtr (* anginc (nth 2 doelist)))))) (setq ypt (* (* (+ rad (* (nth 4 doelist) 0.1)) rscale) (sin (dtr (* anginc (nth 2 doelist)))))) ; height is day (setq zpt (nth 1 doelist)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= (nth 2 doelist) 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= (nth 2 doelist) 24) (command fpt)) ) (setq fh1 (close fh1)) ) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog09a () (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq rscale 0.5) (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) (repeat 31 (command ".3DMESH" "25" "4") (repeat 24 (setq nline (read-line fh1)) (setq doelist (read (strcat "(" nline ")"))) ; radius is hours plus temperature (setq xpt (* (* (+ rad (* (nth 4 doelist) 0.1)) rscale) (cos (dtr (* anginc (nth 2 doelist)))))) (setq ypt (* (* (+ rad (* (nth 4 doelist) 0.1)) rscale) (sin (dtr (* anginc (nth 2 doelist)))))) ; height is day (setq zpt (nth 1 doelist)) (command (list 0 0 zpt)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= (nth 2 doelist) 1) (setq fpt (list xpt ypt 0))) (command pt) (setq pt (list xpt ypt (+ zpt 1))) (command pt) (command (list 0 0 (+ zpt 1))) ; check for last pt, connect to first pt (if (= (nth 2 doelist) 24) (progn (command (list 0 0 zpt)) (setq pt (list (nth 0 fpt) (nth 1 fpt) zpt)) (command pt) (setq pt (list (nth 0 fpt) (nth 1 fpt) (+ zpt 1))) (command pt) (command (list 0 0 (+ zpt 1))) (command pt) )) ) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog10 () (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq rscale 0.5) (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (setq xpt (* (* (+ rad (* (nth 4 doelist) 0.1)) rscale) (cos (dtr (* anginc (nth 2 doelist)))))) (setq ypt (* (* (+ rad (* (nth 4 doelist) 0.1)) rscale) (sin (dtr (* anginc (nth 2 doelist)))))) (setq zpt (nth 1 doelist)) (setq pt (list xpt ypt zpt)) ; get first pt and start polyline (if (= (nth 2 doelist) 1) (progn (setq fpt pt) (command ".3DPOLY" ))) (command pt) ; check for last pt, connect to first pt, close polyline (if (= (nth 2 doelist) 24) (progn (command fpt) (command "c"))) ) (setq fh1 (close fh1)) ) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog11 () ; create a list to act like an 2D array ; 3DMESH 24x31 not 31x24 (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (if (> (nth 4 doelist) vmax) (setq vmax (nth 4 doelist))) (if (< (nth 4 doelist) vmin) (setq vmin (nth 4 doelist))) ; day and hour (setq pt (list (nth 1 doelist) (nth 2 doelist))) ; temp (setq zpt (nth 4 doelist)) ; add to list (setq plist (append plist (list (list pt zpt)))) ) (setq fh1 (close fh1)) ) ) ; create 3DMESH (command ".3DMESH" "24" "31") (setq hcnt 1) (repeat 24 (setq dcnt 1) (repeat 31 (setq zval (nth 1 (assoc (list dcnt hcnt) plist))) (setq pt (list hcnt dcnt (* zval 0.1))) (command pt) (setq dcnt (+ dcnt 1)) ) (setq hcnt (+ hcnt 1)) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog12 () ; create a list to act like an 2D array ; 3DMESH cylinder (setq rscale 0.5) (setq rad (/ 31.0 (* 2 pi))) (setq anginc (/ 360.0 31)) (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (if (> (nth 4 doelist) vmax) (setq vmax (nth 4 doelist))) (if (< (nth 4 doelist) vmin) (setq vmin (nth 4 doelist))) ; day and hour (setq pt (list (nth 1 doelist) (nth 2 doelist))) ; temp (setq zpt (nth 4 doelist)) ; add to list (setq plist (append plist (list (list pt zpt)))) ) (setq fh1 (close fh1)) ) ) ; create 3DMESH (command ".3DMESH" "24" "32") (setq hcnt 1) (repeat 24 (setq dcnt 1) (repeat 31 (setq zval (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* (* (+ rad (* zval 0.1)) rscale) (cos (dtr (* anginc dcnt))))) (setq ypt (* (* (+ rad (* zval 0.1)) rscale) (sin (dtr (* anginc dcnt))))) (setq zpt hcnt) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) (setq dcnt (+ dcnt 1)) ) (setq hcnt (+ hcnt 1)) ) (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog13 () (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano.txt" "r")) (setq months (list 0 31 28 31 30 31 30 31 31 30 31 30 31)) (setq rscale 0.5) (setq rad (/ 24.0 (* 2 pi))) (setq anginc (/ 360.0 24)) (setq nmonth 1) (repeat 12 (setq xpos (* (* (- nmonth 1) (* rad 6.0)) rscale)) (setq ndays (nth nmonth months)) (command ".3DMESH" ndays "25") (repeat ndays (repeat 24 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (setq xpt (* (* (+ rad (* (nth 4 doelist) 0.1)) rscale) (cos (dtr (* anginc (nth 2 doelist)))))) (setq ypt (* (* (+ rad (* (nth 4 doelist) 0.1)) rscale) (sin (dtr (* anginc (nth 2 doelist)))))) (setq zpt (nth 1 doelist)) (setq pt (list (+ xpt xpos) ypt zpt)) ; get first pt (if (= (nth 2 doelist) 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= (nth 2 doelist) 24) (command fpt)) ) (setq fh1 (close fh1)) ) )) (setq nmonth (+ nmonth 1)) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog14 () (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano.txt" "r")) (setq months (list 0 31 28 31 30 31 30 31 31 30 31 30 31)) (setq rscale 0.5) (setq nmonth 1) (setq nday 1.0) (repeat 12 (setq ndays (nth nmonth months)) (command ".3DMESH" (+ ndays 2) "24") (setq dcnt 1) (repeat ndays ; add first pts (if (= dcnt 1) (progn (setq nhour 1) (repeat 24 (command (list (* nday 0.025) nhour 0.0)) (setq nhour (+ nhour 1)) ) )) (repeat 24 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (setq pt (list (* nday 0.025) (nth 2 doelist) (* (nth 4 doelist) 0.1) )) (command pt) (setq nday (+ nday 1)) ) (setq fh1 (close fh1)) ) ) ; add last pts (if (= dcnt ndays) (progn (setq nhour 1) (repeat 24 (command (list (* nday 0.025) nhour 0.0)) (setq nhour (+ nhour 1)) ) )) (setq dcnt (+ dcnt 1)) ) (setq nmonth (+ nmonth 1)) ) (command ".ROTATE3D" "all" "" "x" "0,0,0" "90") (princ) ) ; --------------------------------------------------------------------------- (defun prog15 () ; create a list to act like an 2D array ; 3DMESH concentric circles (setq drad (/ 31.0 (* 2 pi))) (setq danginc (/ 360.0 31)) (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (if (> (nth 4 doelist) vmax) (setq vmax (nth 4 doelist))) (if (< (nth 4 doelist) vmin) (setq vmin (nth 4 doelist))) ; day and hour (setq pt (list (nth 1 doelist) (nth 2 doelist))) ; temp (setq zpt (nth 4 doelist)) ; add to list (setq plist (append plist (list (list pt zpt)))) ) (setq fh1 (close fh1)) ) ) ; create 3DMESH (command ".3DMESH" "24" "32") (setq hcnt 1) (repeat 24 (setq dcnt 1) (repeat 31 (setq zval (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* hcnt (cos (dtr (* danginc dcnt))))) (setq ypt (* hcnt (sin (dtr (* danginc dcnt))))) (setq zpt (* zval 0.1)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) (setq dcnt (+ dcnt 1)) ) (setq hcnt (+ hcnt 1)) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog15a () ; create a list to act like an 2D array ; 3DMESH concentric circles (setq drad (/ 31.0 (* 2 pi))) (setq danginc (/ 360.0 31)) (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (if (> (nth 4 doelist) vmax) (setq vmax (nth 4 doelist))) (if (< (nth 4 doelist) vmin) (setq vmin (nth 4 doelist))) ; day and hour (setq pt (list (nth 1 doelist) (nth 2 doelist))) ; temp (setq zpt (nth 4 doelist)) ; add to list (setq plist (append plist (list (list pt zpt)))) ) (setq fh1 (close fh1)) ) ) ; create 3DMESH (command ".3DMESH" "24" "32") (setq hcnt 1) (setq hrad 4.0) (setq hradinc 0.5) (repeat 24 (setq dcnt 1) (repeat 31 (setq zval (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* hrad (cos (dtr (* danginc dcnt))))) (setq ypt (* hrad (sin (dtr (* danginc dcnt))))) (setq zpt (* zval 0.1)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) (setq dcnt (+ dcnt 1)) ) (setq hcnt (+ hcnt 1)) (setq hrad (+ hrad hradinc)) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog15b () ; create a list to act like an 2D array ; 3DMESH concentric ellipses (setq elpfactor 1.25) (setq drad (/ 31.0 (* 2 pi))) (setq danginc (/ 360.0 31)) (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (if (> (nth 4 doelist) vmax) (setq vmax (nth 4 doelist))) (if (< (nth 4 doelist) vmin) (setq vmin (nth 4 doelist))) ; day and hour (setq pt (list (nth 1 doelist) (nth 2 doelist))) ; temp (setq zpt (nth 4 doelist)) ; add to list (setq plist (append plist (list (list pt zpt)))) ) (setq fh1 (close fh1)) ) ) ; create 3DMESH (command ".3DMESH" "24" "32") (setq hcnt 1) (setq hrad 4.0) (setq hradinc 0.5) (repeat 24 (setq dcnt 1) (repeat 31 (setq zval (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* (* hrad elpfactor) (cos (dtr (* danginc dcnt))))) (setq ypt (* hrad (sin (dtr (* danginc dcnt))))) (setq zpt (* zval 0.1)) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) (setq dcnt (+ dcnt 1)) ) (setq hcnt (+ hcnt 1)) (setq hrad (+ hrad hradinc)) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog16 () ; create a list to act like an 2D array ; 3DMESH sphere/half (setq rscale 0.5) (setq hrad (/ 24.0 (* 2 pi))) (setq hanginc (/ 90.0 24)) (setq drad (/ 31.0 (* 2 pi))) (setq danginc (/ 360.0 31)) (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (if (> (nth 4 doelist) vmax) (setq vmax (nth 4 doelist))) (if (< (nth 4 doelist) vmin) (setq vmin (nth 4 doelist))) ; day and hour (setq pt (list (nth 1 doelist) (nth 2 doelist))) ; temp (setq zpt (nth 4 doelist)) ; add to list (setq plist (append plist (list (list pt zpt)))) ) (setq fh1 (close fh1)) ) ) ; create 3DMESH (command ".3DMESH" "24" "32") (setq hcnt 1) (repeat 24 (setq dcnt 1) (repeat 31 (setq zval (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* (* (* (+ drad (* zval 0.1)) rscale) (cos (dtr (* danginc dcnt)))) (sin (dtr (* hanginc hcnt))))) (setq ypt (* (* (* (+ drad (* zval 0.1)) rscale) (sin (dtr (* danginc dcnt)))) (sin (dtr (* hanginc hcnt))))) (setq zpt (* hrad (cos (dtr (* hanginc hcnt))))) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) (setq dcnt (+ dcnt 1)) ) (setq hcnt (+ hcnt 1)) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog16a () ; create a list to act like an 2D array ; 3DMESH sphere/half (setq rscale 0.5) (setq openang 20) (setq hrad (/ 24.0 (* 2 pi))) (setq hanginc (/ (- 90.0 openang) 24)) (setq drad (/ 31.0 (* 2 pi))) (setq danginc (/ 360.0 31)) (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (if (> (nth 4 doelist) vmax) (setq vmax (nth 4 doelist))) (if (< (nth 4 doelist) vmin) (setq vmin (nth 4 doelist))) ; day and hour (setq pt (list (nth 1 doelist) (nth 2 doelist))) ; temp (setq zpt (nth 4 doelist)) ; add to list (setq plist (append plist (list (list pt zpt)))) ) (setq fh1 (close fh1)) ) ) ; create 3DMESH (command ".3DMESH" "24" "32") (setq hcnt 1) (repeat 24 (setq dcnt 1) (repeat 31 (setq zval (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* (* (* (+ drad (* zval 0.1)) rscale) (cos (dtr (* danginc dcnt)))) (sin (dtr (+ (* hanginc hcnt) openang))))) (setq ypt (* (* (* (+ drad (* zval 0.1)) rscale) (sin (dtr (* danginc dcnt)))) (sin (dtr (+ (* hanginc hcnt) openang))))) (setq zpt (* hrad (cos (dtr (+ (* hanginc hcnt) openang))))) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) (setq dcnt (+ dcnt 1)) ) (setq hcnt (+ hcnt 1)) ) (princ) ) ; --------------------------------------------------------------------------- (defun prog16b () ; create a list to act like an 2D array ; 3DMESH sphere/full (setq rscale 0.5) (setq openang 20) (setq hrad (/ 24.0 (* 2 pi))) (setq hanginc (/ (- 180.0 openang) 24)) (setq drad (/ 31.0 (* 2 pi))) (setq danginc (/ 360.0 31)) (setq fh1 (open "C:\\BobK\\ManageWare\\SOM\\DOE2_data\\milano01.txt" "r")) (setq plist (list )) (while fh1 (setq nline (read-line fh1)) (if nline (progn (setq doelist (read (strcat "(" nline ")"))) (if (> (nth 4 doelist) vmax) (setq vmax (nth 4 doelist))) (if (< (nth 4 doelist) vmin) (setq vmin (nth 4 doelist))) ; day and hour (setq pt (list (nth 1 doelist) (nth 2 doelist))) ; temp (setq zpt (nth 4 doelist)) ; add to list (setq plist (append plist (list (list pt zpt)))) ) (setq fh1 (close fh1)) ) ) ; create 3DMESH (command ".3DMESH" "24" "32") (setq hcnt 1) (repeat 24 (setq dcnt 1) (repeat 31 (setq zval (nth 1 (assoc (list dcnt hcnt) plist))) (setq xpt (* (* (* (+ drad (* zval 0.1)) rscale) (cos (dtr (* danginc dcnt)))) (sin (dtr (+ (* hanginc hcnt) openang))))) (setq ypt (* (* (* (+ drad (* zval 0.1)) rscale) (sin (dtr (* danginc dcnt)))) (sin (dtr (+ (* hanginc hcnt) openang))))) (setq zpt (* hrad (cos (dtr (+ (* hanginc hcnt) openang))))) (setq pt (list xpt ypt zpt)) ; get first pt (if (= dcnt 1) (setq fpt pt)) (command pt) ; check for last pt, connect to first pt (if (= dcnt 31) (command fpt)) (setq dcnt (+ dcnt 1)) ) (setq hcnt (+ hcnt 1)) ) (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- (defun prog20 () (graphscr) (setq objpick (entsel "\nPick a Rectangle, Polygon, or LWPolyline:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) ; get object record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "LWPOLYLINE") (progn (setq zrad (getreal "\nEnter circle radius: ")) (setq cnt 0) (repeat (length objrec) ; check type (if (= (car (nth cnt objrec)) 10) (progn (setq vpt (cdr (nth cnt objrec))) (command ".CIRCLE" vpt zrad) )) (setq cnt (+ cnt 1)) ) )) )) (princ) ) ; --------------------------------------------------------------------------- (defun prog21 () (graphscr) (setq objpick (entsel "\nPick a Regular Polyline:")) (if (/= objpick nil) (progn ; get object entity name (setq mobjname (car objpick)) ; get object record (setq objrec (entget mobjname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POLYLINE") (progn (setq zrad (getreal "\nEnter circle radius: ")) ; get next entity name, record, and type (setq objname (entnext mobjname)) (setq objrec (entget objname)) (setq objtype (cdr (assoc 0 objrec))) (while (= objtype "VERTEX") ; get vertex pt (setq vpt (cdr (assoc 10 objrec))) (command ".CIRCLE" vpt zrad) ; get next entity name, record, and type (setq objname (entnext objname)) (setq objrec (entget objname)) (setq objtype (cdr (assoc 0 objrec))) ) )) )) (princ) ) ; --------------------------------------------------------------------------- (defun prog22 () (graphscr) (setq objpick (entsel "\nPick a 3DMESH:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) ; get object record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POLYLINE") (progn (setq zrad (getreal "\nEnter circle radius: ")) ; get next entity name, record, and type (setq objname (entnext objname)) (setq objrec (entget objname)) (setq objtype (cdr (assoc 0 objrec))) (while (= objtype "VERTEX") ; get vertex pt (setq vpt (cdr (assoc 10 objrec))) (command ".CIRCLE" vpt zrad) ; get next entity name, record, and type (setq objname (entnext objname)) (setq objrec (entget objname)) (setq objtype (cdr (assoc 0 objrec))) ) )) )) (princ) ) ; --------------------------------------------------------------------------- (defun prog22a () (graphscr) (setq objpick (entsel "\nPick a 3DMESH:")) (if (/= objpick nil) (progn ; get object entity name (setq mobjname (car objpick)) ; get object record (setq objrec (entget mobjname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POLYLINE") (progn (setq zfact (getreal "\nEnter Z factor: ")) ; get next entity name, record, and type (setq objname (entnext mobjname)) (setq objrec (entget objname)) (setq objtype (cdr (assoc 0 objrec))) (while (= objtype "VERTEX") ; get vertex pt (setq vpt (cdr (assoc 10 objrec))) ; modify pt (setq vpt (list (nth 0 vpt) (nth 1 vpt) (* (nth 2 vpt) zfact))) ; replace pt (setq objrec (subst (cons 10 vpt) (assoc 10 objrec) objrec)) ; modify object record (entmod objrec) ; get next entity name, record, and type (setq objname (entnext objname)) (setq objrec (entget objname)) (setq objtype (cdr (assoc 0 objrec))) ) ; redisplay object (entupd mobjname) )) )) (princ) ) ; --------------------------------------------------------------------------- (defun prog22b () (graphscr) (setq objpick (entsel "\nPick a 3DMESH:")) (if (/= objpick nil) (progn ; get object entity name (setq mobjname (car objpick)) ; get object record (setq objrec (entget mobjname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POLYLINE") (progn ; y and x pts (setq ytimes (cdr (assoc 71 objrec))) (setq xtimes (cdr (assoc 72 objrec))) ; get next entity name, record, and type (setq objname (entnext mobjname)) (setq objrec (entget objname)) (setq objtype (cdr (assoc 0 objrec))) ; pts list (setq ptslist (list )) (while (= objtype "VERTEX") ; get vertex pt (setq vpt (cdr (assoc 10 objrec))) ; save pt (setq ptslist (append ptslist (list vpt))) ; get next entity name, record, and type (setq objname (entnext objname)) (setq objrec (entget objname)) (setq objtype (cdr (assoc 0 objrec))) ) )) ; draw diagonals in each panel (setq ycnt xtimes) (setq xcnt 0) (repeat (- ytimes 1) (repeat (- xtimes 1) ; get panel pts (setq pt1 (nth xcnt ptslist)) (setq pt2 (nth (+ xcnt 1) ptslist)) (setq pt3 (nth ycnt ptslist)) (setq pt4 (nth (+ ycnt 1) ptslist)) (command ".LINE" pt1 pt4 "") (command ".LINE" pt2 pt3 "") (setq xcnt (+ xcnt 1)) (setq ycnt (+ ycnt 1)) ) ) )) (princ) ) ; --------------------------------------------------------------------------- (defun prog23a () (graphscr) (setq objpick (entsel "\nPick a Spline:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) ; get object record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "SPLINE") (progn (setq zrad (getreal "\nEnter circle radius: ")) (setq cnt 0) (repeat (length objrec) ; check type (if (= (car (nth cnt objrec)) 10) (progn (setq vpt (cdr (nth cnt objrec))) (command ".CIRCLE" vpt zrad) )) (if (= (car (nth cnt objrec)) 11) (progn (setq vpt (cdr (nth cnt objrec))) (command ".POLYGON" "3" vpt "i" zrad) )) (setq cnt (+ cnt 1)) ) )) )) (princ) ) ;---------------------------------------------------------------------------- (defun prog24a () (setq objpick (entsel "\nPick a spline:")) (if (/= objpick nil) (progn ; get object entity name (setq pobjname (car objpick)) ; get object record (setq pobjrec (entget pobjname)) ; object type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (princ "\nSart/End pts: ") (princ spt) (princ ept) )) )) (princ) ) ;---------------------------------------------------------------------------- (defun prog24b () (setq objpick (entsel "\nPick a spline:")) (if (/= objpick nil) (progn ; get object entity name (setq pobjname (car objpick)) ; get object record (setq pobjrec (entget pobjname)) ; object type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (princ "\nSart/End pts: ") (princ spt) (princ ept) ; check for closure and get perimeter (setq pobjclosed (cdr (assoc 70 pobjrec))) (if (= pobjclosed nil) (setq pobjclosed 0) (setq pobjclosed (boole 1 pobjclosed 1))) ; alternate method ;(setq pobjclosed 0) ;(if (equal spt ept) (setq pobjclosed 1)) (command ".AREA" "O" pobjname ) (setq pperm (getvar "PERIMETER")) (setq parea (getvar "AREA")) (princ "\nPerm/Area/Closed: ") (princ pperm) (princ " ") (princ parea) (princ " ") (princ pobjclosed) )) )) (princ) ) ;---------------------------------------------------------------------------- (defun prog24c () (setq objpick (entsel "\nPick a spline:")) (setq npts (getint "\nEnter number of pts:")) (if (/= objpick nil) (progn ; get object entity name (setq pobjname (car objpick)) ; get object record (setq pobjrec (entget pobjname)) ; object type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (princ "\nSart/End pts: ") (princ spt) (princ ept) ; check for closure and get perimeter (setq pobjclosed (cdr (assoc 70 pobjrec))) (if (= pobjclosed nil) (setq pobjclosed 0) (setq pobjclosed (boole 1 pobjclosed 1))) ; alternate method ;(setq pobjclosed 0) ;(if (equal spt ept) (setq pobjclosed 1)) (command ".AREA" "O" pobjname ) (setq pperm (getvar "PERIMETER")) (setq parea (getvar "AREA")) (princ "\nPerm/Area/Closed: ") (princ pperm) (princ " ") (princ parea) (princ " ") (princ pobjclosed) (princ"\n") ; set point format (setvar "PDMODE" 34) (setvar "PDSIZE" -5.0) ; place pts (if (= pobjclosed 0) (command ".POINT" spt)) (command ".DIVIDE" pobjname npts) (if (= pobjclosed 0) (command ".POINT" ept)) )) )) (princ) ) ;---------------------------------------------------------------------------- (defun prog24d () (setq objpick (entsel "\nPick a spline:")) (setq npts (getint "\nEnter number of pts:")) (if (/= objpick nil) (progn ; get object entity name (setq pobjname (car objpick)) ; get object record (setq pobjrec (entget pobjname)) ; object type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (princ "\nSart/End pts: ") (princ spt) (princ ept) ; check for closure and get perimeter (setq pobjclosed (cdr (assoc 70 pobjrec))) (if (= pobjclosed nil) (setq pobjclosed 0) (setq pobjclosed (boole 1 pobjclosed 1))) ; alternate method ;(setq pobjclosed 0) ;(if (equal spt ept) (setq pobjclosed 1)) (command ".AREA" "O" pobjname ) (setq pperm (getvar "PERIMETER")) (setq parea (getvar "AREA")) (princ "\nPerm/Area/Closed: ") (princ pperm) (princ " ") (princ parea) (princ " ") (princ pobjclosed) (princ"\n") ; set point format (setvar "PDMODE" 34) (setvar "PDSIZE" -5.0) ; place pts (if (= pobjclosed 0) (command ".POINT" spt)) (command ".DIVIDE" pobjname npts) (if (= pobjclosed 0) (command ".POINT" ept)) ; get pts (setq ptslist (list )) (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POINT") (progn ; pt (setq pt (cdr (assoc 10 objrec))) (setq ptslist (append ptslist (list pt))) (entdel objname) )) ; next entity (setq objname (entnext objname)) ) (princ "\nPts: ") (princ ptslist) (princ"\n") )) )) (princ) ) ;---------------------------------------------------------------------------- (defun prog24e () (setq objpick (entsel "\nPick a spline:")) (setq npts (getint "\nEnter number of pts:")) (if (/= objpick nil) (progn ; get object entity name (setq pobjname (car objpick)) ; get object record (setq pobjrec (entget pobjname)) ; object type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (princ "\nSart/End pts: ") (princ spt) (princ ept) ; check for closure and get perimeter (setq pobjclosed (cdr (assoc 70 pobjrec))) (if (= pobjclosed nil) (setq pobjclosed 0) (setq pobjclosed (boole 1 pobjclosed 1))) ; alternate method ;(setq pobjclosed 0) ;(if (equal spt ept) (setq pobjclosed 1)) (command ".AREA" "O" pobjname ) (setq pperm (getvar "PERIMETER")) (setq parea (getvar "AREA")) (princ "\nPerm/Area/Closed: ") (princ pperm) (princ " ") (princ parea) (princ " ") (princ pobjclosed) (princ"\n") ; set point format (setvar "PDMODE" 34) (setvar "PDSIZE" -5.0) ; place pts (if (= pobjclosed 0) (command ".POINT" spt)) (command ".DIVIDE" pobjname npts) (if (= pobjclosed 0) (command ".POINT" ept)) ; get pts (setq ptslist (list )) (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POINT") (progn ; pt (setq pt (cdr (assoc 10 objrec))) (setq ptslist (append ptslist (list pt))) (entdel objname) )) ; next entity (setq objname (entnext objname)) ) (princ "\nPts: ") (princ ptslist) (princ"\n") ; place triangle at pts (setq xspace (/ pperm npts)) (if (= pobjclosed 0) (setq xspace (/ pperm (+ npts 1)))) (princ "\nPerm/Pts/Spacing: ") (princ pperm) (princ " ") (princ npts) (princ " ") (princ xspace) (setq prad (/ xspace 4.0)) (setq cnt 0) (repeat (length ptslist) (setq pt (nth cnt ptslist)) (command ".POLYGON" "3" pt "i" prad) (setq cnt (+ cnt 1)) ) )) )) (princ) ) ;---------------------------------------------------------------------------- (defun prog24f () (setq objpick (entsel "\nPick a spline:")) (setq npts (getint "\nEnter number of pts:")) (if (/= objpick nil) (progn ; get object entity name (setq pobjname (car objpick)) ; get object record (setq pobjrec (entget pobjname)) ; object type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (princ "\nSart/End pts: ") (princ spt) (princ ept) ; check for closure and get perimeter (setq pobjclosed (cdr (assoc 70 pobjrec))) (if (= pobjclosed nil) (setq pobjclosed 0) (setq pobjclosed (boole 1 pobjclosed 1))) ; alternate method ;(setq pobjclosed 0) ;(if (equal spt ept) (setq pobjclosed 1)) (command ".AREA" "O" pobjname ) (setq pperm (getvar "PERIMETER")) (setq parea (getvar "AREA")) (princ "\nPerm/Area/Closed: ") (princ pperm) (princ " ") (princ parea) (princ " ") (princ pobjclosed) (princ"\n") ; set point format (setvar "PDMODE" 34) (setvar "PDSIZE" -5.0) ; place pts (if (= pobjclosed 0) (command ".POINT" spt)) (command ".DIVIDE" pobjname npts) (if (= pobjclosed 0) (command ".POINT" ept)) ; get pts (setq ptslist (list )) (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POINT") (progn ; pt (setq pt (cdr (assoc 10 objrec))) (setq ptslist (append ptslist (list pt))) (entdel objname) )) ; next entity (setq objname (entnext objname)) ) (princ "\nPts: ") (princ ptslist) (princ"\n") ; place triangle at pts (setq ido 1) (while (= ido 1) (setq ssobjs (ssadd)) (setq xspace (/ pperm npts)) (if (= pobjclosed 0) (setq xspace (/ pperm (+ npts 1)))) (princ "\nPerm/Pts/Spacing: ") (princ pperm) (princ " ") (princ npts) (princ " ") (princ xspace) (setq prad (getdist "\nEnter size:")) (setq cnt 0) (repeat (length ptslist) (setq pt (nth cnt ptslist)) (command ".POLYGON" "3" pt "i" prad) ; add to selection list (setq newobjname (entlast)) (setq ssobjs (ssadd newobjname ssobjs)) (setq cnt (+ cnt 1)) ) ; next (setq ans (getstring "\nTry another size? ")) (if (= (strcase ans) "N") (setq ido 0)) (if (/= (strcase ans) "N") (command ".ERASE" ssobjs "")) ) )) )) (princ) ) ;---------------------------------------------------------------------------- (defun prog24g () (setq objpick (entsel "\nPick a spline:")) (setq npts (getint "\nEnter number of pts:")) (if (/= objpick nil) (progn ; get object entity name (setq pobjname (car objpick)) ; get object record (setq pobjrec (entget pobjname)) ; object type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (princ "\nSart/End pts: ") (princ spt) (princ ept) ; check for closure and get perimeter (setq pobjclosed (cdr (assoc 70 pobjrec))) (if (= pobjclosed nil) (setq pobjclosed 0) (setq pobjclosed (boole 1 pobjclosed 1))) ; alternate method ;(setq pobjclosed 0) ;(if (equal spt ept) (setq pobjclosed 1)) (command ".AREA" "O" pobjname ) (setq pperm (getvar "PERIMETER")) (setq parea (getvar "AREA")) (princ "\nPerm/Area/Closed: ") (princ pperm) (princ " ") (princ parea) (princ " ") (princ pobjclosed) (princ"\n") ; set point format (setvar "PDMODE" 34) (setvar "PDSIZE" -5.0) ; place pts (if (= pobjclosed 0) (command ".POINT" spt)) (command ".DIVIDE" pobjname npts) (if (= pobjclosed 0) (command ".POINT" ept)) ; get pts (setq ptslist (list )) (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POINT") (progn ; pt (setq pt (cdr (assoc 10 objrec))) (setq ptslist (append ptslist (list pt))) (entdel objname) )) ; next entity (setq objname (entnext objname)) ) (princ "\nPts: ") (princ ptslist) (princ"\n") ; place triangle at pts (setq ido 1) (while (= ido 1) (setq ssobjs (ssadd)) (setq xspace (/ pperm npts)) (if (= pobjclosed 0) (setq xspace (/ pperm (+ npts 1)))) (princ "\nPerm/Pts/Spacing: ") (princ pperm) (princ " ") (princ npts) (princ " ") (princ xspace) (setq prad (getdist "\nEnter size:")) (setq cnt 0) (repeat (length ptslist) (setq pt (nth cnt ptslist)) (command ".POLYGON" "3" pt "i" prad) ; add to selection list (setq newobjname (entlast)) (setq ssobjs (ssadd newobjname ssobjs)) ; get angle to next pt (setq npt (nth (+ cnt 1) ptslist)) (if (/= npt nil) (progn (setq pang (rtd (angle pt npt))) (princ "\nAngle: ") (princ pang) (setq rotang (- 90 pang)) (command ".ROTATE" "last" "" pt (* rotang -1)) )) (setq cnt (+ cnt 1)) ) ; last triangle (if (= pobjclosed 0) (command ".ROTATE" "last" "" pt (* rotang -1))) ; next (setq ans (getstring "\nTry another size? ")) (if (= (strcase ans) "N") (setq ido 0)) (if (/= (strcase ans) "N") (command ".ERASE" ssobjs "")) ) )) )) (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; ; change the current properties ; to the entity selected ; (defun prog30 ( / objlayer objcolor objltype objlscale objelev objthick objtsize objtstyle objpick objname objrec objtype ) (graphscr) (setq objpick (entsel "\nPick an object to set properties:")) (if (/= objpick nil) (progn ; get properties (setq objlayer (getvar "CLAYER")) (setq objcolor (getvar "CECOLOR")) (setq objltype (getvar "CELTYPE")) (setq objlscale (getvar "LTSCALE")) (setq objelev (getvar "ELEVATION")) (setq objthick (getvar "THICKNESS")) (setq objtsize (getvar "TEXTSIZE")) (setq objtstyle (getvar "TEXTSTYLE")) ; display properties (princ "\n") (princ "\nOld layer: ") (princ objlayer) (princ "\n color: ") (princ objcolor) (princ "\n linetype: ") (princ objltype) (princ "\n linescale: ") (princ objlscale) (princ "\n elevation: ") (princ objelev) (princ "\n thickness: ") (princ objthick) (princ "\n text size: ") (princ objtsize) (princ "\n text style: ") (princ objtstyle) ; get object entity name (setq objname (car objpick)) ; get object record (setq objrec (entget objname)) ; get object type (setq objtype (cdr (assoc 0 objrec))) (if (/= objtype "INSERT") (progn ; get layer (setq objlayer (cdr (assoc 8 objrec))) ; get linetype (setq objltype (cdr (assoc 6 objrec))) (if (= objltype nil) (setq objltype "BYLAYER")) ; get linescale (setq objlscale (cdr (assoc 48 objrec))) (if (= objlscale nil) (setq objlscale 1.0)) ; get color (setq objcolor (cdr (assoc 62 objrec))) (if (= objcolor nil) (setq objcolor "BYLAYER")) (if (numberp objcolor) (setq objcolor (itoa (abs objcolor)))) ; get elevation (setq objelev (nth 2 (cdr (assoc 10 objrec)))) ; get thickness (setq objthick (cdr (assoc 39 objrec))) (if (= objthick nil) (setq objthick 0.0)) ; check if text (if (= objtype "TEXT") (progn (setq objtsize (cdr (assoc 40 objrec))) (setq objtstyle (cdr (assoc 7 objrec))) (if (= objtstyle nil) (setq objtstyle "STANDARD")) ) ) ; set properties (setvar "CLAYER" objlayer) (setvar "CECOLOR" objcolor) (setvar "CELTYPE" objltype) (setvar "LTSCALE" objlscale) (setvar "ELEVATION" objelev) (setvar "THICKNESS" objthick) (setvar "TEXTSIZE" objtsize) (setvar "TEXTSTYLE" objtstyle) ; display properties (princ "\n") (princ "\nNew layer: ") (princ objlayer) (princ "\n color: ") (princ objcolor) (princ "\n linetype: ") (princ objltype) (princ "\n linescale: ") (princ objlscale) (princ "\n elevation: ") (princ objelev) (princ "\n thickness: ") (princ objthick) (princ "\n text size: ") (princ objtsize) (princ "\n text style: ") (princ objtstyle) ) ) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; change the size and style ; of picked text ; (defun prog31 ( / textsize newsize textstyle newstyle objstyle objpick objname objrec objtype ) (graphscr) ; get defaults (setq textsize (getvar "TEXTSIZE")) (setq textstyle (getvar "TEXTSTYLE")) ; get new values (princ "\nEnter new text size <") (princ (rtos textsize)) (princ ">:") (setq newsize (getdist)) (if (/= newsize nil) (setq textsize newsize)) (princ "\nEnter new text style <") (princ textstyle) (princ ">:") (setq newstyle (getstring)) (if (/= newstyle "") (setq textstyle (strcase newstyle))) (princ "\nChange to: ") (princ textsize) (princ ", ") (princ textstyle) (while ; get text (setq objpick (entsel "\nPick text:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) ; get object record (setq objrec (entget objname)) ; get object type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "TEXT") (progn ; change size (setq objrec (subst (cons 40 textsize) (assoc 40 objrec) objrec)) ; change style (setq objtstyle (cdr (assoc 7 objrec))) (if (/= objtstyle nil) (setq objrec (subst (cons 7 textstyle) (assoc 7 objrec) objrec)) (setq objrec (append objrec (list (cons 7 textstyle)))) ) ; modify object record (entmod objrec) ; redisplay object (entupd objname) ) ) ) (exit) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; change the size and style ; of selected text ; (defun prog32 ( / textsize newsize textstyle newstyle objstyle objselect objpick objname objrec objtype ) (graphscr) ; get defaults (setq textsize (getvar "TEXTSIZE")) (setq textstyle (getvar "TEXTSTYLE")) ; get new values (princ "\nEnter new text size <") (princ (rtos textsize)) (princ ">:") (setq newsize (getdist)) (if (/= newsize nil) (setq textsize newsize)) (princ "\nEnter new text style <") (princ textstyle) (princ ">:") (setq newstyle (getstring)) (if (/= newstyle "") (setq textstyle (strcase newstyle))) (princ "\nChange to: ") (princ (rtos textsize)) (princ ", ") (princ textstyle) ; get selection (princ "\nPick text to modify:") (setq objselect (ssget)) ; go through selection list (if (/= objselect nil) (progn (setq cnt 0) (repeat (sslength objselect) ; get object entity name (setq objname (ssname objselect cnt)) ; get object record (setq objrec (entget objname)) ; get object type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "TEXT") (progn ; change size (setq objrec (subst (cons 40 textsize) (assoc 40 objrec) objrec)) ; change style (setq objtstyle (cdr (assoc 7 objrec))) (if (/= objtstyle nil) (setq objrec (subst (cons 7 textstyle) (assoc 7 objrec) objrec)) (setq objrec (append objrec (list (cons 7 textstyle)))) ) ; modify object record (entmod objrec) ; redisplay object (entupd objname) ) ) ; inc count (setq cnt (+ cnt 1)) ) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; change circle radius ; ( defun prog33a ( / newradius objpick objname objrec objtype ) (graphscr) ; get new values (princ "\nEnter new circle radius: ") (setq newradius (getdist)) (while ; get circle (setq objpick (entsel "\nPick circle:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) ; get object record (setq objrec (entget objname)) ; get object type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "CIRCLE") (progn ; change size (setq objrec (subst (cons 40 newradius) (assoc 40 objrec) objrec)) ; modify object record (entmod objrec) ; redisplay object (entupd objname) ) ) ) (exit) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; change entity elevation ; ( defun prog33b ( / newelev objelev pt objpick objname objrec objtype ) (graphscr) ; get defaults (setq objelev (getvar "ELEVATION")) ; get new values (princ "\nEnter new elevation <") (princ (rtos objelev)) (princ ">:") (setq newelev (getdist)) (if (/= newelev nil) (setq objelev newelev)) (while ; get object (setq objpick (entsel "\nPick object:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) ; get object record (setq objrec (entget objname)) ; get object type (setq objtype (cdr (assoc 0 objrec))) ; change elev (setq pt (cdr (assoc 10 objrec))) (setq pt (list (nth 0 pt) (nth 1 pt) objelev)) (setq objrec (subst (cons 10 pt) (assoc 10 objrec) objrec)) ; for line, change end point (if (= objtype "LINE") (progn (setq pt (cdr (assoc 11 objrec))) (setq pt (list (nth 0 pt) (nth 1 pt) objelev)) (setq objrec (subst (cons 11 pt) (assoc 11 objrec) objrec)) )) ; modify object record (entmod objrec) ; redisplay object (entupd objname) ) (exit) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; turn off object layer ; ( defun prog33c ( / objpick objname objlayer objrec ) (graphscr) (setq objpick (entsel "\nPick an object:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) ; get object record (setq objrec (entget objname)) ; get object layer (setq objlayer (cdr (assoc 8 objrec))) ; check if current layer (if (/= (getvar "CLAYER") objlayer) ; turn off layer (command ".LAYER" "OFF" objlayer "") ) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; save/retrieve layers ; ( defun prog33d ( / layrec ) (textscr) ; get first layer (setq y 1) (setq layrec (tblnext "LAYER" y)) (while layrec (princ layrec) (princ "\n") (setq y nil) (setq layrec (tblnext "LAYER")) ) (princ) ) ; --------------------------------------------------------------------------- ; ; change polyline elevation and thickness ; show elevation and thickness first ; (defun prog34 ( / polyelev polythick newelev newthick polyname objpick objname objrec objtype ) (graphscr) (while ; get object (setq objpick (entsel "\nPick object:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) (setq polyname objname) ; get object record (setq objrec (entget objname)) ; get object type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "LWPOLYLINE") (progn ; get new values (setq polyelev (cdr (assoc 38 objrec))) (princ "\nEnter new elevation <") (princ (rtos polyelev)) (princ ">:") (setq newelev (getdist)) (if (/= newelev nil) (setq polyelev newelev)) (setq polythick (cdr (assoc 39 objrec))) (if (= polythick nil) (setq polythick 0.0)) (princ "\nEnter new thickness <") (princ (rtos polythick)) (princ ">:") (setq newthick (getdist)) (if (/= newthick nil) (setq polythick newthick)) ; change elev (setq objrec (subst (cons 38 polyelev) (assoc 38 objrec) objrec)) ; change thickness (setq objthick (cdr (assoc 39 objrec))) (if (/= objthick nil) (setq objrec (subst (cons 39 polythick) (assoc 39 objrec) objrec)) (setq objrec (append objrec (list (cons 39 polythick)))) ) ; modify object record (entmod objrec) ; redisplay polyline (entupd polyname) ) ) ) (exit) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; change polyline elevation and thickness ; show elevation and thickness first ; (defun prog34a ( / polyelev polythick newelev newthick polyname objpick objname objrec objtype ) (graphscr) (while ; get object (setq objpick (entsel "\nPick polyline:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) (setq polyname objname) ; get object record (setq objrec (entget objname)) ; get object type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POLYLINE") (progn ; get new values (setq polyelev (nth 2 (cdr (assoc 10 objrec)))) (princ "\nEnter new elevation <") (princ (rtos polyelev)) (princ ">:") (setq newelev (getdist)) (if (/= newelev nil) (setq polyelev newelev)) (setq polythick (cdr (assoc 39 objrec))) (if (= polythick nil) (setq polythick 0.0)) (princ "\nEnter new thickness <") (princ (rtos polythick)) (princ ">:") (setq newthick (getdist)) (if (/= newthick nil) (setq polythick newthick)) ; change elev (setq pt (cdr (assoc 10 objrec))) (setq pt (list (nth 0 pt) (nth 1 pt) polyelev)) (setq objrec (subst (cons 10 pt) (assoc 10 objrec) objrec)) ; change thickness (setq objthick (cdr (assoc 39 objrec))) (if (/= objthick nil) (setq objrec (subst (cons 39 polythick) (assoc 39 objrec) objrec)) (setq objrec (append objrec (list (cons 39 polythick)))) ) ; modify object record (entmod objrec) ; get first vertex (setq objname (entnext objname)) (setq objrec (entget objname)) (while (= (cdr (assoc 0 objrec)) "VERTEX") ; change elev (setq pt (cdr (assoc 10 objrec))) (setq pt (list (nth 0 pt) (nth 1 pt) polyelev)) (setq objrec (subst (cons 10 pt) (assoc 10 objrec) objrec)) ; modify object record (entmod objrec) ; get next record (setq objname (entnext objname)) (setq objrec (entget objname)) ) ; redisplay polyline (entupd polyname) ) ) ) (exit) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; change polyline elevation and thickness ; show elevation and thickness first ; (defun prog34b ( / polyelev polythick newelev newthick polyname objpick objname objrec objtype ) (graphscr) (while ; get object (setq objpick (entsel "\nPick polyline:")) (if (/= objpick nil) (progn ; get object entity name (setq objname (car objpick)) (setq polyname objname) ; get object record (setq objrec (entget objname)) ; get object type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POLYLINE") (progn ; get new values (setq polyelev (nth 2 (cdr (assoc 10 objrec)))) (princ "\nEnter new elevation <") (princ (rtos polyelev)) (princ ">:") (setq newelev (getdist)) (if (/= newelev nil) (setq polyelev newelev)) (setq polythick (cdr (assoc 39 objrec))) (if (= polythick nil) (setq polythick 0.0)) (princ "\nEnter new thickness <") (princ (rtos polythick)) (princ ">:") (setq newthick (getdist)) (if (/= newthick nil) (setq polythick newthick)) ; change elev (setq pt (cdr (assoc 10 objrec))) (setq pt (list (nth 0 pt) (nth 1 pt) polyelev)) (setq objrec (subst (cons 10 pt) (assoc 10 objrec) objrec)) ; change thickness (setq objthick (cdr (assoc 39 objrec))) (if (/= objthick nil) (setq objrec (subst (cons 39 polythick) (assoc 39 objrec) objrec)) (setq objrec (append objrec (list (cons 39 polythick)))) ) ; modify object record (entmod objrec) ; redisplay polyline (entupd polyname) ) ) ) (exit) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; count blocks ; (defun prog35 ( ) (graphscr) ; set blocks list (setq blklist nil) ; get first entity (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "INSERT") (progn ; get block name (setq blkname (cdr (assoc 2 objrec))) (if (= blklist nil) (setq blklist (list (cons blkname 0)))) (setq blkquan (cdr (assoc blkname blklist))) (if (/= blkquan nil) (setq blklist (subst (cons blkname (+ blkquan 1)) (assoc blkname blklist) blklist)) (setq blklist (append blklist (list (cons blkname 1)))) ) ) ) ; get next entity name (setq objname (entnext objname)) ) ; display results (textscr) (setq cnt 0) (princ "\n") (repeat (length blklist) (princ " ") (princ (nth cnt blklist)) (princ "\n") (setq cnt (+ cnt 1)) ) ; setup output file (if (> (length blklist) 0) (progn (setq fh1 (open "c:\\ex05_29.txt" "w")) (setq cnt 0) (repeat (length blklist) (princ (nth cnt blklist) fh1) (princ "\n" fh1) (setq cnt (+ cnt 1)) ) (setq cnt 0) (repeat (length blklist) (princ "\"" fh1) (princ (car (nth cnt blklist)) fh1) (princ "\"\," fh1) (princ (cdr (nth cnt blklist)) fh1) (princ "\n" fh1) (setq cnt (+ cnt 1)) ) (close fh1) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; acum lines ; ( defun prog36 () (graphscr) ; set line list (setq acumlist nil) ; get first entity (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "LINE") (progn ; get start/end (setq spt (cdr (assoc 10 objrec))) (setq ept (cdr (assoc 11 objrec))) ; compute length (setq dist (/ (distance spt ept) 12)) ; get layer (setq objlayer (cdr (assoc 8 objrec))) (if (= acumlist nil) (setq acumlist (list (cons objlayer 0)))) (setq acum (cdr (assoc objlayer acumlist))) (if (/= acum nil) (setq acumlist (subst (cons objlayer (+ acum dist)) (assoc objlayer acumlist) acumlist)) (setq acumlist (append acumlist (list (cons objlayer dist)))) ) ) ) ; get next entity name (setq objname (entnext objname)) ) ; display results (textscr) (setq cnt 0) (princ "\n") (repeat (length acumlist) (princ " ") (princ (nth cnt acumlist)) (princ "\n") (setq cnt (+ cnt 1)) ) ; setup output file (if (> (length acumlist) 0) (progn (setq fh1 (open "c:\\ex05_30.txt" "w")) (setq cnt 0) (repeat (length acumlist) (princ "\"" fh1) (princ (car (nth cnt acumlist)) fh1) (princ "\"\," fh1) (princ (cdr (nth cnt acumlist)) fh1) (princ "\n" fh1) (setq cnt (+ cnt 1)) ) (close fh1) ) ) (princ) ) ; --------------------------------------------------------------------------- ; ; acum area and perimeter ; using a single list ; (defun prog37 () (graphscr) ; set area and perm list (setq arealist nil) ; get first entity (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type and close flag (setq objtype (cdr (assoc 0 objrec))) (setq objclose (cdr (assoc 70 objrec))) (if (= objclose nil) (setq objclose 0) (setq objclose (boole 1 objclose 1))) ; use "POLYLINE" for < Rel 14 (if (and (= objtype "LWPOLYLINE") (= objclose 1)) (progn ; get area and perimeter (command ".AREA" "OBJECT" objname) (setq polyarea (getvar "AREA")) (setq polyarea (/ polyarea 144)) (setq polyperm (getvar "PERIMETER")) (setq polyperm (/ polyperm 12)) ; get layer (setq objlayer (cdr (assoc 8 objrec))) ; check for empty list (if (= arealist nil) (setq arealist (list (cons objlayer (list 0 0))))) ; acum area and perm (setq acum (cdr (assoc objlayer arealist))) (if (/= acum nil) (progn (setq acumarea (nth 0 acum)) (setq acumperm (nth 1 acum)) (setq arealist (subst (cons objlayer (list (+ acumarea polyarea) (+ acumperm polyperm))) (assoc objlayer arealist) arealist)) ) (setq arealist (append arealist (list (cons objlayer (list polyarea polyperm))))) ) ) ) ; get next entity name (setq objname (entnext objname)) ) ; display results (textscr) (setq cnt 0) (princ "\n") (repeat (length arealist) (princ " ") (princ (nth cnt arealist)) (princ "\n") (setq cnt (+ cnt 1)) ) ; setup output file (if (> (length arealist) 0) (progn (setq fh1 (open "c:\\ex05_31.txt" "w")) (setq cnt 0) (repeat (length arealist) (princ "\"" fh1) (princ (nth 0 (nth cnt arealist)) fh1) (princ "\"\," fh1) (princ (nth 1 (nth cnt arealist)) fh1) (princ "\," fh1) (princ (nth 2 (nth cnt arealist)) fh1) (princ "\n" fh1) (setq cnt (+ cnt 1)) ) (close fh1) ) ) (princ) ) ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ;---------------------------------------------------------------------------- (defun prog50a () ; splines in rectangle wraped on cylinder ; as lines ; get dimensions (command ".ZOOM" "e") (setq xmax (nth 0 (getvar "EXTMAX"))) (setq xmin (nth 0 (getvar "EXTMIN"))) (setq xlen (- xmax xmin)) (setq rad (/ xlen (* 2 pi))) (setq npts (getint "\nEnter number of pts:")) (setq pobjname (entnext)) (while (/= pobjname nil) ; get entity record (setq pobjrec (entget pobjname)) ; get entity type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (setq pobjclosed 0) (if (equal spt ept) (setq pobjclosed 1)) (command ".AREA" "O" pobjname ) (setq pperm (getvar "PERIMETER")) (princ "\nSpline: ") (princ (rtos pperm 4 3)) ; place pts (if (= pobjclosed 0) (command ".POINT" spt)) (command ".DIVIDE" pobjname npts) (if (= pobjclosed 0) (command ".POINT" ept)) ; get pts (setq ptslist (list )) (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POINT") (progn ; pt (setq pt (cdr (assoc 10 objrec))) (setq ptslist (append ptslist (list pt))) (entdel objname) )) ; next entity (setq objname (entnext objname)) ) (setq cnt 0) (command ".3DPOLY" ) (repeat (length ptslist) (setq xpt (nth 0 (nth cnt ptslist))) (setq ypt (nth 1 (nth cnt ptslist))) (setq cang (* (/ xpt xlen) 360.0)) (setq nxpt (* rad (cos (dtr cang)))) (setq nypt (* rad (sin (dtr cang)))) (setq nzpt ypt) (setq cpt (list nxpt nypt nzpt)) (command cpt) (setq cnt (+ cnt 1)) ) (command "") )) ; next entity (setq pobjname (entnext pobjname)) ) (princ) ) ;---------------------------------------------------------------------------- (defun prog50b () ; splines in rectangle wraped on cylinder ; as spheres ; get dimensions (command ".ZOOM" "e") (setq xmax (nth 0 (getvar "EXTMAX"))) (setq xmin (nth 0 (getvar "EXTMIN"))) (setq xlen (- xmax xmin)) (setq rad (/ xlen (* 2 pi))) (setq npts (getint "\nEnter number of pts:")) (setq pobjname (entnext)) (while (/= pobjname nil) ; get entity record (setq pobjrec (entget pobjname)) ; get entity type (setq pobjtype (cdr (assoc 0 pobjrec))) (if (= pobjtype "SPLINE") (progn ; start/end points (setq spt (cdr (assoc 10 pobjrec))) (setq cnt 0) (repeat (length pobjrec) (if (= (car (nth cnt pobjrec)) 11) (setq ept (cdr (nth cnt pobjrec)))) (setq cnt (+ cnt 1)) ) (setq pobjclosed 0) (if (equal spt ept) (setq pobjclosed 1)) (command ".AREA" "O" pobjname ) (setq pperm (getvar "PERIMETER")) (princ "\nSpline: ") (princ (rtos pperm 4 3)) ; place pts (if (= pobjclosed 0) (command ".POINT" spt)) (command ".DIVIDE" pobjname npts) (if (= pobjclosed 0) (command ".POINT" ept)) ; get pts (setq ptslist (list )) (setq objname (entnext)) (while (/= objname nil) ; get entity record (setq objrec (entget objname)) ; get entity type (setq objtype (cdr (assoc 0 objrec))) (if (= objtype "POINT") (progn ; pt (setq pt (cdr (assoc 10 objrec))) (setq ptslist (append ptslist (list pt))) (entdel objname) )) ; next entity (setq objname (entnext objname)) ) ; sphere radius (setq srad (/ (/ pperm npts) 1.00)) (setq cnt 0) ;(command ".3DPOLY" ) (repeat (length ptslist) (setq xpt (nth 0 (nth cnt ptslist))) (setq ypt (nth 1 (nth cnt ptslist))) (setq cang (* (/ xpt xlen) 270.0)) (setq nxpt (* rad (cos (dtr cang)))) (setq nypt (* rad (sin (dtr cang)))) (setq nzpt ypt) (setq cpt (list nxpt nypt nzpt)) ;(command cpt) (command ".SPHERE" cpt srad) (setq cnt (+ cnt 1)) ) ;(command "") )) ; next entity (setq pobjname (entnext pobjname)) ) (princ) ) ;---------------------------------------------------------------------------- ;---------------------------------------------------------------------------- ;----------------------------------------------------------------------------