用lisp编制的画功率圆图的程序
程序需要数据：
xd、xq、cosφ、空载励磁电流ifo（A）、额定容量sn（kVA）、转子电阻r15（欧）。
程序以白延年“水轮发电机设计与计算”编制。
其中调相容量与充电容量按手册22～23页确定。
程序中假定采用静止可控硅励磁，其最低励磁电压取为10V。
程序中用一个dcl对话框输入数据。在autocad中输入(load “glyt”)，再输入glyt即可。
本次上传程序与大家共享。程序中肯定有不足之处，请多提意见和建议，有什么功能要添加只要提出具体算法，我可在程序中加上。
请不吝赐教。 我感觉 只需知道xd、xq、cosφ，就可以。
不用空载励磁电流ifo（A）、额定容量sn（kVA）、转子电阻r15（欧）这些。 楼主的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(/ angdan 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)
)
;;;关闭函数结束 楼主编一个 画定子线圈 端部形状 的 lisp 程序
佩服楼主 为什么只能用“只看该作者”才能看到图片及程序包，不然要我反复登录，除了文字说明什么都看不到？
下载学习一下，谢谢楼主。 谢谢大家的支持，由于办公室上网需到专门的电子阅览室，因此一般晚上才上网。
给在家的回复不及时，见谅！
cxw770:你也是水发的吧？
希望你对我的1500-44极电机也提点意见。
至于圈式定子线圈，我们很早就用lisp画图了。
其实我发这个程序能起抛砖引玉的作用我的满足了。 本帖最后由 long123sp 于 2011-3-24 15:02 编辑
回复 5# zlz1976
上网时少，发贴更少，能碰到诚心交流的更更少。
谢谢你！！！
可能发贴时有个只看楼主的框没去掉勾。
试图编辑重发，但没看出是什么原因导致5楼所情况，请版主或知道的网友告知。 回复 2# cxw770
望把你的想法更明确地告诉我。
本程是在三四年前编的，因lisp程序可读性太差，在程序加了太多注释，见笑了！
平时工作在设计方案出来后，大量的时间在画图，因工资以图纸量计。
编本程序是写说明书或作投标方案时都画功率圆画烦了才作的。
多多交流！ 看图就不错，想亲身感受一下，可在上班地方用的MECHANICAL2011里APPLOAD进去再GLYT不干，
才用AUTOCAD不久，正在网上查如何在MECHANICAL里用LISP的方法。
不知是浏览器原因还是别的原因，总要手动刷新，内容才真实完全。 我是刚刚学lisp。
另外，见你们讨论的1500-44极电机。
也提不出意见。
我看都可以。 楼主：我怎么用CADLISP调不出来呀，不能用呀{:1_428:}，能不能告诉使用方法呀，（本人笨的很） 本帖最后由 tb-2001 于 2011-5-12 15:52 编辑
很需要这样的程序,下载了,谢谢楼主!
建议楼主把最低励磁电压改为 0.5Uf0
另外圈式定子线圈也是很需要这样的程序 本帖最后由 y1949b 于 2011-7-10 18:48 编辑
说来很惭愧这么好的程序我居然不会用dcl
我就如下图这样加载的，但运行“glyt”没有反应
大家能说说，是怎么用这个程序吗？
此问题已解决！ 就是文件存放目录的问题 回复 1# long123sp
还请您说说好吗 谢谢您了！ 没人说说吗？ 依旧无人说说 余版！请耐心等待，楼主比较忙，工资按图纸计算可能正在赶图呢 本帖最后由 tb-2001 于 2011-6-12 10:28 编辑
回复 16# y1949b
你的加载步骤没有错，但是要把下载的文件放到AutoCAD目录下，然后再加载 能有人说说吗 居然还是无人问津有那么夸张吗？
页:
[1]
2