- 积分
- -889
- 回帖
- 0
- 西莫币
-
- 贡献
-
- 威望
-
- 存款
-
- 阅读权限
- 0
- 最后登录
- 1970-1-1
该用户从未签到
|
发表于 2011-3-24 07:01
|
显示全部楼层
来自: 中国天津
楼主的lisp程序编的确实很好。
;;;画功率圆图
(defun c:glyt (/ pd pe pk xd xq csf xl lo1 xo1 pa1 po1 o1g kk kc sn r15 ifo osn)
;;;主程序开始
;;;初始化DCL
(setq dcl_id (load_dialog "glyt"))
(if (not (new_dialog "glyt" dcl_id))
(exit)
)
(action_tile "accept" "(done_accept)") ;;;动作回调
(action_tile "cancel" "(done_cancel)") ;;;动作回调
(start_dialog)
(print)
(command "ucs" "n" (getpoint "请输入功率圆圆心"))
(setq osn (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(tac)
(qta)
(cshpd)
(cshpe)
(cshpk)
(xhx)
(setvar "osmode" osn)
(unload_dialog dcl_id)
)
;;;主程序end
;;;设置D点的坐标,初始化PD表
(defun cshpd (/ yl pd1) ;;;初始化PD表
(setq pd nil)
(setq yl 0)
(repeat 30
(setq yl (+ 2.5 yl))
(setq pd1 (list xl yl))
(setq pd (cons pd1 pd)) ;;;本表为从低
)
(setq pd (reverse pd)) ;;;表逆序,由低到高
)
;;;cshpd结束
;;;以下定义函数cshpe求E点的坐标,并存入pe表
;;;根据直角三角形相似的原理,求E点的坐标
;;;pe为E点的返回值
;;;lo1为失励圆直径
;;;gao为D点的Y坐标
;;;dan为DE或O1C之间的距离
;;;ang为DO1直线的夹角,起点为D
(defun cshpe (/ cou yl pd1 do1 dan ang pe1)
(setq pe nil)
(setq cou 29)
(setq yl 75)
(repeat 30
(setq pd1 (nth cou pd)) ;抽项
(setq do1 (distance pd1 po1)) ;求D至O1距离
(setq dan (/ (expt lo1 2) do1)) ;求DE离
(setq ang (angle pd1 po1)) ;求度
(setq pe1 (polar pd1 ang dan)) ;标
(setq pe (cons pe1 pe)) ;pe表由低到高
(setq yl (- yl 2.5)) ;高度减2.5
(setq cou (- cou 1)) ;计数器减1
)
(setq pe (cons po1 pe))
(setq pe (cons "" pe)) ;;;加入""在PE表中
(setq pe (reverse pe)) ;;;表逆序
(setq pe (cons "pline" pe)) ;;;加入"pline"在表中
(foreach pe1 pe (command pe1)) ;;;画理论稳定极线
(setq pe (cdr pe)) ;;;在PE表中去掉"pline"
(setq pe (reverse pe)) ;;;表逆序,低至高
(setq pe (cdr pe)) ;;;去掉""
(setq pe (cdr pe)) ;;;去掉po1点
)
;;;cshpe结束
;;;以下定义函数cshpk求K点的坐标
;;;根据直角三角形的原理,求K点的坐标
;;;要传入E点坐标及O1点坐标及O1G之间距离
(defun cshpk (/ cou pe1 dan xk pk1)
(setq pk nil)
(setq cou 30)
(repeat 30
(setq cou (- cou 1))
(setq pe1 (nth cou pe)) ;;;抽最后一项
(setq dan (+ o1g (distance po1 pe1))) ;;;求G点至E点离
(setq xk (+ xo1 (sqrt (- (expt dan 2) (expt (cadr pe1) 2)))))
(setq pk1 (list xk (cadr pe1))) ;;;求出K点坐标
(setq pk (cons pk1 pk)) ;;;PK表由低至高
)
(setq pk (cons (list (+ xo1 o1g) 0) pk)) ;;;将F点的坐标入表PK
(setq pk (cons "" pk)) ;;;加入""在PE
(setq pk (reverse pk)) ;;;表逆序,由高低
(setq pk (cons "pline" pk)) ;;;加"pline"入表PK
(foreach pk1 pk (command pk1)) ;;;画运行稳定极线
(setq pk (cdr pk)) ;;;在PE表中去掉"pline"
(setq pk (reverse pk)) ;;;表逆序,低至高
(setq pk (cdr pk)) ;;;去掉""
(setq pk (cdr pk)) ;;;去掉F点
)
;;;cshpk结束
;;;定义画圆弧及写数字数
(defun tac ()
(command "arc" "10,0" "0,10" "-10,0")
(command "arc" "20,0" "0,20" "-20,0")
(command "arc" "30,0" "0,30" "-30,0")
(command "arc" "40,0" "0,40" "-40,0")
(command "arc" "50,0" "0,50" "-50,0")
(command "text" "1.2,-4.5" "3" "0" "0" ^C)
(command "text" "7.5,-4" "3" "0" "0.2" ^c)
(command "text" "17.5,-4" "3" "0" "0.4" ^c)
(command "text" "27.5,-4" "3" "0" "0.6" ^c)
(command "text" "37.5,-4" "3" "0" "0.8" ^c)
(command "text" "47.5,-4" "3" "0" "1.0" ^c)
(command "text" "-12.5,-4" "3" "0" "0.2" ^c)
(command "text" "-22.5,-4" "3" "0" "0.4" ^c)
(command "text" "-32.5,-4" "3" "0" "0.6" ^c)
(command "text" "-42.5,-4" "3" "0" "0.8" ^c)
(command "text" "-52.5,-4" "3" "0" "1.0" ^c)
(command "text" "0.5,11" "3" "0" "0.2" ^c)
(command "text" "0.5,21" "3" "0" "0.4" ^c)
(command "text" "0.5,31" "3" "0" "0.6" ^c)
(command "text" "0.5,41" "3" "0" "0.8" ^c)
(command "text" "0.5,51" "3" "0" "1.0" ^C)
(command "text" "-35,-10" "3" "0" "Kc=" ^C)
(command "text" "-15,-10" "3" "0" "欠励运行" ^c)
(command "text" "-35,-16" "3" "0" "Qc=" ^c)
(command "text" "-15,-16" "3" "0" "MVAR" ^c)
(command "text" "6,-10" "3" "0" "过励运行" ^c)
(command "text" "24,-10" "3" "0" " Kk=" ^c)
(command "text" "24,-16" "3" "0" " Qk=" ^c)
(command "text" "44,-16" "3" "0" "MVAR" ^c)
)
;;;tac结束
;;;定义其它一些画线及写文本的数,csf代表COSΦ,求出A点Y坐标
(defun qta(/ ang dan pb pa pa2 pl1 o1l ol1 xo2 paa str)
;第一部分,求坐标
(setq xl (- (* 50 (/ 1 xd)))) ;;;求出L点的X坐标
(setq lo1 (* 50 (/ (- xd xq) xd xq))) ;;;求出L点至O1点X轴长即失励圆径
(setq xo1 (- xl lo1)) ;;;求出O1点的X坐标
(setq xo2 (- xl (/ lo1 2))) ;;;求出O2点的X坐标
(setq po1 (list xo1 0)) ;;;求出O1点标
(setq pa (list (* 50 (sqrt (- 1 (expt csf 2)))) (* 50 csf)));;;求出A点坐标
(setq pb (list (- (car pa)) (* 50 csf))) ;;;求出B点标
(setq ang (angle po1 pa)) ;;;求θ角
(setq o1l (* lo1 (cos ang))) ;;;求出O1点至L1点距离
(setq dan (- (distance po1 pa) o1l)) ;;;求出L1点至A点距离
(setq pl1 (polar pa (+ pi ang) dan)) ;;;求出L1点标
(command "text" (list (- (car pl1) 2) (+ (cadr pl1) 1.125)) "3" "0" "L1" ^C)
;;;上句标L1
(setq o1g (/ dan 10)) ;;;O1G等于O1F为十分之一L1A
(setq ol1 (* lo1 (cos (/ ang 2)))) ;;;求出o1点至l1'点距离
(setq pa1 (polar po1 (/ ang 2) (+ ol1 dan))) ;;;求出PA'坐标
(setq pa2 (list (+ xo1 lo1 dan) 0)) ;;;求出PA"标
(setq kk (/ (car pa2) 50)) ;;;求出Kk的值,调相容量
(setq kc (* (/ 1 xd) (- 1 (/ 10 ifo r15)))) ;;;求出Kc的值,充电容量
;第二部分,画线
(command "arc" pa2 pa1 pa) ;;;画转子电流限制线
(command "circle" (list xo2 0) "d" lo1) ;;;画失励圆
(command "circle" po1 o1g) ;;;画储备圆
(command "line" (list (- xo1 o1g 5) 0) (list 55 0) "") ;;;画X轴线
(command "line" "0,-5" "0,55" "") ;;;画O点处Y轴线
(command "line" pa pb "") ;;;画AB线段
(command "line" (list xl -10) (list xl 80) "");;;画过L点的铅垂线
(command "line" (list xo2 (- (+ (/ lo1 2) 5))) (list xo2 (+ (/ lo1 2) 5)) "")
;;;上句画过O2的Y线
(command "line" po1 pa "") ;;;画O1A段
(setq ang (angle (list 0 0) pa))
(command "line" "0,0" (polar (list 0 0) ang 70) "") ;画功率因数线
(setq paa (list (car pa) (+ (cadr pa) 2.5))) ;设写COSΦ=的点
(setq str (rtos csf 2 3))
(setq str (strcat "COSΦ=" str))
(command "text" paa "4" (/ (* 180 ang) pi) str ^C);写COSΦ=
;第三部分,其它写字母,线
(setq sn (/ sn 1000.0))
(print sn)
(command "text" "33,-10" "3" "0" (rtos kk 2 3) ^c)
(command "text" "33,-16" "3" "0" (rtos (* sn kk) 2 3) ^c)
(command "text" "-27.5,-10" "3" "0" (rtos kc 2 3) ^c)
(command "text" "-27.5,-16" "3" "0" (rtos (* sn kc) 2 3) ^c)
(command "text" (list (- xo1 3.875) 1.125) "3" "0" "O1" ^C) ;;;标O1
(command "text" (list xo2 -3.875) "3" "0" "O2" ^C) ;;;标O2
(command "text" (list (+ xl 1) 1.125) "3" "0" "L" ^C) ;;;标L
(command "text" (list (+ xo1 o1g) -3.875) "3" "0" "F" ^C) ;;;标F
(command "text" (list (+ (* 50 (sqrt (- 1 (expt csf 2)))) 3) (* 50 csf))
"3" "0" "A" ^C) ;;;标A
(command "text" (list (- (car pa)) (+ (* 50 csf) 2)) "3" "0" "B" ^C) ;;;标B
(command "text" "-1.5,64" "3" "0" "%%uPN" ^C) ;;;标PN
(command "text" "-1.5,60" "3" "0" "SN" ^C) ;;;标SN
(command "text" "-1.5,64" "3" "0" "%%uPN" ^C) ;;;标PN
(command "text" "60,-5" "3" "0" "%%UQ" ^C) ;;;标Q
(command "text" "59,-9" "3" "0" "SN" ^C) ;;;标SN
(command "text" (list (- xo1 10) 25) "4" "0" "失励圆" ^C) ;;;标失励圆
(command "text" (list (- xo1 10) 40) "4" "0" "理论稳定极限线" ^C) ;;;标理论稳定极限线
(command "text" (list (- xo1 10) 55) "4" "0" "运行稳定极限线" ^C) ;;;标运行稳定极限线
(command "text" "55,20" "4" "0" "功率圆" ^C) ;;;标功率圆
(command "text" "45,40" "4" "0" "转子电流限制线" ^C) ;;;标转子电流限制线
(command "text" "8,60" "4" "0" "额定功率限制线" ^C) ;;;标额定功率限制线
(command "line" (list (- xo1 10) 23.875) "@9.6,0" "") ;;;画失励圆下划
(command "line" (list (- xo1 10) 38.875) "@22.4,0" "") ;;;画理论下划
(command "line" (list (- xo1 10) 53.875) "@22.4,0" "") ;;;画运行下划
(command "line" "55,18.875" "@9.6,0" "") ;;;画功率圆下划
(command "line" "45,38.875" "@22.4,0" "") ;;;画转子下划
(command "line" "8,58.875" "@22.4,0" "") ;;;画额定下划
)
;;;qta结束
;;;定义xhx函数画EK线,DO1线及文本下面的
(defun xhx (/ ang dan pd1 pg1 pe1 pk1 x y)
(setq pd1 (nth 28 pd))
(setq dan (distance pd1 po1))
(setq ang (angle pd1 po1))
(setq dan (+ dan o1g))
(setq pg1 (polar pd1 ang dan))
(command "line" pg1 pd1 "") ;画GD
(setq x (car pg1))
(setq y (cadr pg1))
(command "text" (list x (- y 3.875)) "3" "0" "G" ^C) ;标G
(setq pe1 (nth 28 pe))
(setq pk1 (nth 28 pk))
(setq x (car pe1))
(setq y (cadr pe1))
(setq pd1 (list (- x 1.5) (+ y 1.125))) ;设写E的标
(command "text" pd1 "3" "0" "E" ^C) ;写E
(setq x (car pk1))
(setq pg1 (list (+ x 1.5) (+ y 1.125))) ;设写K的坐标
(command "text" pg1 "3" "0" "K" ^C) ;写K
(command "text" (list (- xl 2) 72.5) "3" "0" "D" ^C);写D
(setq x (car pe1))
(setq pd1 (list (- x 5) y))
(setq x (car pk1))
(setq pg1 (list (+ x 5) y))
(command "line" pd1 pg1 "") ;画EK线
(command "line" "55,18.875" "48.9898,10" "")
(command "line" "45,38.875" pa1 "")
(command "line" "8,58.875" (list 20 (* 50 csf)) "")
(command "line" (list (+ xo1 12.4) 53.875) (nth 20 pk) "")
(command "line" (list (+ xo1 12.4) 38.875) (nth 15 pe) "")
(command "line" (polar (list (- xl (/ lo1 2)) 0) 2 (/ lo1 2)) (list (- xo1 0.4) 23.875) "")
)
;;;xhx结束
;;;定义动作函数
(defun done_accept()
(setq xd (atof (get_tile "xd")))
(setq xq (atof (get_tile "xq")))
(setq csf (atof (get_tile "csf")))
(setq ifo (atof (get_tile "ifo")))
(setq sn (atof (get_tile "sn")))
(setq r15 (atof (get_tile "r15")))
(done_dialog 1)
)
;;;动作函数结束
;;;定义关闭函数
(defun done_cancel()
(done_dialog 2)
(unload_dialog dcl_id)
(exit)
)
;;;关闭函数结束 |
评分
-
查看全部评分
|