www.pudn.com > velocity.rar > 画彩色流场.lsp, change:2007-11-30,size:3337b


;;;----------------------------------------------------------- 
;;;************This is a program for drawing fliud************ 
;;;----------------------------------------------------------- 
 
 
 (defun c:liuchang () 
   
 ;;;  选择要画的数据文件 
(setq fn (getfiled"选择数据文件" "//" "" 4)) 
      (setq f (open fn "r")) 
   ;;;;;;;;;;;;;;;;;;; 
   (setq Color_Type 10)                    ;;设置颜色表类型 
   (setq iStar (+ 80 Color_Type) iEnd (+ 170 Color_Type)) 
   (setq V_max 0.30 V_min -0.022)             ;;设置最大流速z和最小流速 
   (setq Color_Step (/ (- V_max V_min) (- iEnd iStar))) 
   ;;;;;;;;;;;;;;;;;;;;;;;;; 
   (setq size 120)                         ;;流量箭头大小调节   在标尺时是实际大小除以这个数 
   (setq x0 0 y0 0) 
   (setq count 0)                                    ;;间隔数 
      (while (setq se (read-line f)) 
	     (setq count(+ 1 count)) 
	    ;; 数据实数付值 
	     (setq se (strcat se "\n")) 
	     (setq len (strlen se)) 
	     (setq L '() k 1 s_str "" p nil) 
	     (while(<= k len) 
	       (setq one (substr se k 1)) 
	       (if(or (= one":") (= one",") (= one " ") (= one (chr 9)) (= one "\n") (= one "Space") (= one "Tab")) 
		 (if p 
		   (progn 
		     (if(= (type (read s_str)) 'SYM) 
		        (setq L (cons s_str L)) 
		        (setq L (cons (read s_str) L)) 
		   ) 
		   (setq s_str "" p nil) 
		 )) 
		 (setq s_str (strcat s_str one) p T) 
		 ) 
		 (setq k(+ 1 k)) 
	      ) 
	     (setq L (reverse L)) 
	     ;;在此修改文件输入顺序格式   不同格式选择不同顺序 
	     (setq x (nth 0 L))                
                       (setq y (nth 1 L)) 
                       (setq u (nth 2 L)) 
                       (setq v (nth 3 L)) 
	;;颜色取值 
	(setq Vec (sqrt (+ (* u u) (* v v)))) 
	(if(> Vec V_max) (setq Vec V_max)) 
	(if(< Vec V_min) (setq Vec V_min)) 
	(setq Value_Color (+ (* (fix (/ (/ (- Vec V_min) Color_Step) 10)) 10) iStar))    ;;计算其对应的颜色值 
	(command "-color")        ;;取颜色 
        (command Value_Color)  
	     ;; 箭头大小 
	     (setq x (- x x0)) 
	     (setq y (- y y0)) 
	     (setq u (* u size)) 
	     (setq v (* v size))	 
      ;;将数据付点 
   
               (setq pt1 (list x y ) 
 	             pt2 (list (+ x u) (+ y v)) 
                ) 
;;            (setq pt1 (list x y z)  pt2 (list u v c))           ;;  三维时使用 
;;;      开始画线及箭头 
            (setq len (distance pt1 pt2)) 
            (if (and (/= len 0) (= 0 (rem count 1))) 
	      (progn 
	        (command "line" pt1 pt2 "") 
	        (setq s (angle pt1 pt2)) 
	        (setq pt3 (polar pt2 (+ s (* pi 0.92)) (/ len 4.))) 
	        (setq pt4 (polar pt2 (+ s (* pi 1.08)) (/ len 4.))) 
         	(command "line" pt3 pt2 pt4 "") 
		;(command "zoom" "a") 
		) 
	     ) 
      ;;;     画完线 
       ) 
      (command "") 
   ;;;;;;画上标尺 
     (setq point (getpoint "\\n拾取一点point画上标尺")) 
      (setq x (car point) y (cadr point)) 
    (setq i 0) 
      (repeat 17 
	  (setq icolor (- iEnd (* i 10))) 
	 (setq anther_point '((+ x 1000) y)) 
	 (command "-color")        ;;取颜色 
         (command icolor) 
	 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
	 (command "line" point  anther_point) 
 
	 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
	 (setq i (+ i 1)) 
	 (setq y (+ y 500)) 
	 (setq point '(x y)) 
	 ) 
    
      (alert "===>>>流场已顺利画完<<<===") 
      ;(command "zoom" "a") 
  )