求助：从资料里粘贴的平差程序，运行不了，求高人指点！！！

Grace_Lee · 发表于 2012-3-12 11:40:22

小妹是初学者，从资料里直接拷贝的visual lisp 源程序，在编辑器里检查文字也没有问题，运行的时候说是参数类型错误: fixnump: nil，不知道该怎么发现错误以及解决!

这个程序是用来计算管网平差的，由以下几个部分组成：

1.管网拓扑关系的自动搜索。利用Visual LISP自动生成关联矩阵，同时自动判别出节点和管段之间的关系，进而生成节点间关系矩阵。根据节点和管段的数据结构，对管网中的节点和管段依次自动编号，方便后面的水力计算。

2.管网原始数据的输入。通过调用外部文本获得各管段的管长和各节点的节点流量。

3.管段流量的初分和管径的选择。管段流量的初分采用了最小平方和法，管径的选择和手工计算时管径的确定方法相同。

4.管网的水力计算。管网的水力计算采用了解节点方程法。

5.气流方向和水力计算结果的标注。程序利用Visual LISP图形处理的能力，根据计算结果分析出气流的方向，采用箭头标注出气流的方向；同时根据计算出的节点气压、管段流量等数据自动标注在管网图形中。使得计算结果更加直观化。

(vl-load-com)
(defun gj (par_q)
(setq ll (cond
((and (< par_q 338.75) (> par_q 40.70)) 100)
((and (< par_q 40.70) (> par_q 9.05)) 150)
((and (< par_q 9.05) (> par_q 4.89)) 200)
((and (< par_q 4.89) (> par_q 2.82)) 225)
((and (< par_q 2.82) (> par_q 1.09)) 250)
((and (< par_q 1.09) (> par_q 0.486)) 300)
((and (< par_q 0.486) (> par_q 0.242)) 350)
((and (< par_q 0.242) (> par_q 0.131)) 400)
((and (< par_q 0.131) (> par_q 0.0753)) 450)
((and (< par_q 0.0753) (> par_q 0.0291)) 500)
((and (< par_q 0.0291) (> par_q 0.0130)) 600)
((and (< par_q 0.0130) (> par_q 0.00646)) 700)
((and (< par_q 0.00646) (> par_q 0.00349)) 800)
)
)
)
(setq compd '(100 150 200 225 250 300 350 400 450 500 600 700 800 900 1000 1200))
(setq comparfa '(338.75 40.70 9.05 4.89 2.82 1.09 0.486 0.242 0.131 0.0753 0.0291 0.0130 0.00646 0.00349 0.00201 0.0007764))
(defun zh (p)
(setq m1 (rtos (car p) 2 2))
(setq m2 (rtos (cadr p) 2 2))
(setq m3 (rtos (caddr p) 2 2))
(strcat m1 "," m2 "," m3)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;把坐标转化为字符串的形式
///////////////////////////////////////////////////////////////////////////
(defun zh1 (p)
(setq m1 (rtos (car p) 2 2))
(setq m2 (rtos (cadr p) 2 2))
(setq m3 (rtos (caddr p) 2 2))
(strcat m1 " " m2 " " m3)
)
///////////////////////////////////////////////////////////////////////////
(defun c:yww8 ()
(setq totalpipe (ssget "x" (list (cons 0 "line"))))
//////////totalpipe所有管线的集合
(setq lenofpipe (sslength totalpipe))
//////////////////////lenofpipe管段数
(setq totalpoint '())
(setq n1 0)
(repeat lenofpipe
(setq pipe (ssname totalpipe n1))
(setq p1 (cdr (assoc 10 (entget pipe))))
(if (= (vl-position p1 totalpoint) nil)
(setq totalpoint (cons p1 totalpoint))
)
(setq p2 (cdr (assoc 11 (entget pipe))))
(if (= (vl-position p2 totalpoint) nil)
(setq totalpoint (cons p2 totalpoint))
)
(setq n1 (1+ n1))
)
(setq lenofpoint (length totalpoint))
(setq num1 (- lenofpoint 1))
(setq n2 0)
(setq list2 '())
(repeat lenofpoint
(setq p3 (nth n2 totalpoint))
(setq str1 (zh p3))
(setq n2 (1+ n2))
(setq list2 (cons (cons n2 p3) list2))
)
(setq dfn1 (open "f:/程序设计/管网计算/wen3.txt" "w"))
(setq n3 0)
(setq pipe_point '())
(repeat lenofpipe
(setq ass0 '())
(setq n4 0)
(setq n5 0)
(setq s1 (ssname totalpipe n3))
(setq sn3 (rtos (+ 1 n3) 2 0))
(setq p1 (cdr (assoc 10 (entget s1))))
(repeat lenofpoint
(setq plist2 (nth n4 list2))
(if (and (= (nth 1 plist2) (nth 0 p1))
(= (nth 2 plist2) (nth 1 p1))
(= (nth 3 plist2) (nth 2 p1))
)
(progn (setq sp1 (rtos (nth 0 plist2) 2 0))
(setq ass2 (nth 0 plist2))
)
)
(setq n4 (1+ n4))
)
(setq p2 (cdr (assoc 11 (entget s1))))
(repeat lenofpoint
(setq plist2 (nth n5 list2))
(if (and (= (nth 1 plist2) (nth 0 p2))
(= (nth 2 plist2) (nth 1 p2))
(= (nth 3 plist2) (nth 2 p2))
)
(progn (setq sp2 (rtos (nth 0 plist2) 2 0))
(setq ass3 (nth 0 plist2))
)
)
(setq n5 (1+ n5))
)
(setq str2 (strcat sn3 " " sp1 " " sp2))
(setq ass0 (cons ass3 ass0))
(setq ass0 (cons ass2 ass0))
(setq ass0 (cons n3 ass0))
(setq pipe_point (cons ass0 pipe_point))
(write-line str2 dfn1)
(setq n3 (1+ n3))
)
(setq np_point '())
(setq n16 lenofpipe)
(repeat lenofpipe
(setq n17 (- lenofpipe n16))
(setq ass15 (nth 1 (nth n17 pipe_point)))
(setq ass16 (nth 2 (nth n17 pipe_point)))
(setq ass14 '())
(setq ass14 (cons ass16 ass14))
(setq ass14 (cons ass15 ass14))
(setq ass14 (cons n16 ass14))
(setq np_point (cons ass14 np_point))
(setq n16 (1- n16))
)
(setq n1 lenofpoint)
(setq point_pipe '())
(repeat lenofpoint
(setq n2 (- lenofpipe 1))
(setq ass2 '())
(repeat lenofpipe
(setq ass1 (nth n2 np_point))
(if (or (= (nth 1 ass1) n1) (= (nth 2 ass1) n1))
(progn (setq ass3 (nth 0 ass1))
(setq ass2 (cons ass3 ass2))
)
)
(setq n2 (- n2 1))
)
(setq ass2 (cons n1 ass2))
(setq point_pipe (cons ass2 point_pipe))
(setq n1 (- n1 1))
)
(setq join (vlax-make-safearray
vlax-vbdouble
(cons 1 lenofpoint)
(cons 1 lenofpipe)
)
)
(setq n3 0)
(setq n5 1)
(repeat lenofpoint
(setq ass4 (nth n3 point_pipe))
(setq len3 (- (length ass4) 1))
(setq n4 1)
(repeat len3
(setq ass5 (nth n4 ass4))
(setq ass6 (nth (- ass5 1) np_point))
(setq ass7 (nth 1 ass6))
(if (= ass7 n5)
(vlax-safearray-put-element join n5 ass5 1)
(vlax-safearray-put-element join n5 ass5 -1)
)
(setq n4 (1+ n4))
)
(setq n5 (1+ n5))
(setq n3 (1+ n3))
)
(setq zjoin (vlax-make-safearray
vlax-vbdouble
(cons 1 lenofpipe)
(cons 1 lenofpoint)
)
)
(setq n8 1)
(repeat lenofpipe
(setq n9 1)
(repeat lenofpoint
(setq ass12 (vlax-safearray-get-element join n9 n8))
(vlax-safearray-put-element zjoin n8 n9 ass12)
(setq n9 (1+ n9))
)
(setq n8 (1+ n8))
)
(setq longofpipe
(vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))
)////////////////////////////////////////////////定义管段长度数组
(setq q_node1
(vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint))
)////////////////////////////////////////////////定义节点流量
(setq q_node
(vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管网拓扑信息的提取
(defun c:yww1 ()
//////////pipe
n1
lenofpipe
totalpoint
p1
p2
p0
ang1
(command "-layer" "s" "管段号" "")
(setq n1 0)
(repeat lenofpipe
(setq pipe (ssname totalpipe n1))
(setq p1 (cdr (assoc 10 (entget pipe))))
(setq p2 (cdr (assoc 11 (entget pipe))))
(setq p0 (mapcar '(lambda (x y) (/ (+ x y) 2)) p1 p2))
(setq pipe (vlax-ename->vla-object pipe))
(setq ang1 (* (/ 180 pi) (vla-get-angle pipe)))
(if (and(> ang1 90)(< ang1 270))
(setq ang1 (- ang1 180))
)
(if(= ang1 180)
(setq ang1 0)
)
(if(= ang1 270)
(setq ang1 90)
)
(setq n1 (1+ n1))
(command "text" p0 35 ang1 (rtos n1 2 0))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管段编号并标注
(defun c:yww2 ()
////////dfn
lenofpoint
n2
p3
str1
(setvar "cmdecho" 0)
(command "-layer" "s" "节点号" "")
(setq dfn (open "f:/程序设计/管网计算/wen1.txt" "w"))
///////输入节点坐标到文本中
(setq n2 0)
(repeat lenofpoint
(setq p3 (nth n2 totalpoint))
(command "circle" p3 35)
(setq str1 (zh1 p3))
(setq str1 (strcat (rtos (1+ n2) 2 0) " " str1))
(write-line str1 dfn)
(setq n2 (1+ n2))
(command "text" "j" "mc" p3 30 0 (rtos n2 2 0))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;节点编号并标注
(defun c:yww11()
(initget 1 "A B")
(setq ass1 (getkword "选择方式/A(调用文本)/B(用户输入):"))
(if(= ass1 "A")
(progn(setq filename (getfiled "原始数据文本" "" "txt" 2))
(setq ptfile (open filename "r"))
(setq n1 1)
(repeat lenofpipe
(setq pp (read-line ptfile))
(setq pp1 (read(strcat "(" pp ")")))
(vlax-safearray-put-element longofpipe n1 (nth 4 pp1))
(setq n1 (1+ n1))
)
)
(progn(setq n2 1)
(repeat lenofpipe
(setq ass2 (rtos n2 2 2))
(setq ass3 (getreal (strcat "\n输入" ass2 "管长:" )))
(vlax-safearray-put-element diaofpipe n2 ass1)
(vlax-safearray-put-element longofpipe n2 ass3)
(setq n2 (1+ n2))
)
)
)
//////////////////////////////////////////////得出管段长度数组longofpipe
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管段长度的获得
(defun c:yww23()
(setq filename1 (getfiled "节点流量文本" "" "txt" 2))
(setq ptfile1 (open filename1 "r"))
(setq n1 1)
(repeat lenofpoint
(setq pp1 (read-line ptfile1))
(setq pp0 (read(strcat "(" pp1 ")")))
(vlax-safearray-put-element q_node n1 (nth 4 pp0))
(vlax-safearray-put-element q_node1 n1 (nth 4 pp0))
(setq n1 (1+ n1))
)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;调用文本得到节点流量
(defun c:yww3()//////n1 n2 n3 ss1 main s_joint p2 p3 sub
(setq diaofpipe
(vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))
)
(setq coma (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)))
(setq pipearfa (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)))
(setq n1 1)
(setq ylen (1+ lenofpoint))
(setq amatrix (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint)(cons 1 ylen)))
(repeat lenofpoint
(setq n2 (- n1 1))
(setq p1 (nth n2 totalpoint))
(setq ss1 (ssget "x" (list (cons -4 "<or")
(cons -4 "<and")
(cons 0 "line")(cons 10 p1)
(cons -4 "and>")
(cons -4 "<and")
(cons 0 "line")(cons 11 p1)
(cons -4 "and>")
(cons -4 "or>")
)
)
)
(setq main (sslength ss1))
(setq n3 0)
(repeat main
(setq s_joint (ssname ss1 n3))
(setq n3 (1+ n3))
(setq p2 (cdr(assoc 10 (entget s_joint))))
(setq p3 (cdr(assoc 11 (entget s_joint))))
(if (or(/= (car p1)(car p2))(/= (cadr p1)(cadr p2)))
(progn(setq sub (vl-position p2 totalpoint))
(setq sub (1+ sub))
(vlax-safearray-put-element amatrix n1 sub -1)
)
)
(if (or(/= (car p1)(car p3))(/= (cadr p1)(cadr p3)))
(progn(setq sub (vl-position p3 totalpoint))
(setq sub (1+ sub))
(vlax-safearray-put-element amatrix n1 sub -1)
)
)
)
(vlax-safearray-put-element amatrix n1 n1 main)
(setq n1 (1+ n1))
)
(setq n4 1)
(setq num1 (- lenofpoint 1))
(setq bmatrix (vlax-make-safearray vlax-vbdouble (cons 1 num1)(cons 1 lenofpoint)))
(setq n1 1)
(repeat lenofpoint
(setq ass1 (vlax-safearray-get-element q_node n1))
(vlax-safearray-put-element amatrix n1 ylen ass1)
(setq n1 (1+ n1))
)
(setq n14 1)
(repeat num1
(setq n15 1)
(repeat lenofpoint
(setq ass10 (vlax-safearray-get-element amatrix (1+ n14) (1+ n15)))
(vlax-safearray-put-element bmatrix n14 n15 ass10)
(setq n15 (1+ n15))
)
(setq n14 (1+ n14))
)
(setq n4 1)
(setq num2 (- num1 1))
(repeat num2
(setq maxa 0)
(setq len1 (- lenofpoint n4))
(setq n6 n4)
(repeat len1
(if (> (abs(vlax-safearray-get-element bmatrix n6 n4)) maxa)
(progn(setq maxa (abs(vlax-safearray-get-element bmatrix n6 n4)))
(setq n5 n6)
)
)
(setq n6 (1+ n6))
)
(if(/= n5 n4)
(progn(setq n7 1)
(repeat lenofpoint
(setq ass1 (vlax-safearray-get-element bmatrix n4 n7))
(vlax-safearray-put-element bmatrix n4 n7 (vlax-safearray-get-element bmatrix n5 n7))
(vlax-safearray-put-element bmatrix n5 n7 ass1)
(setq n7 (1+ n7))
)
)
)
(setq n8 (+ n4 1))
(setq len2 (- num1 n4))
(setq len4 (+ 1 len2))
(repeat len2
(setq n9 (1+ n4))
(setq ass3 (vlax-safearray-get-element bmatrix n8 n4))
(setq ass4 (vlax-safearray-get-element bmatrix n4 n4))
(repeat len4
(setq ass1 (vlax-safearray-get-element bmatrix n8 n9))
(setq ass2 (vlax-safearray-get-element bmatrix n4 n9))
(setq ass5 (- ass1 (/ (* ass2 ass3) ass4)))
(vlax-safearray-put-element bmatrix n8 n9 ass5)
(setq n9 (1+ n9))
)
(vlax-safearray-put-element bmatrix n8 n4 0)
(setq n8 (1+ n8))
)
(setq n4 (1+ n4))
)
(setq cf_node (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint)))
(setq ass6 (/ (vlax-safearray-get-element bmatrix num1 lenofpoint) (vlax-safearray-get-element bmatrix num1 num1)))
(vlax-safearray-put-element cf_node lenofpoint ass6)
(setq n12 num2)
(repeat num2
(setq ass7 0)
(setq len2 (- num1 n12))
(setq n13 (1+ n12))
(repeat len2
(setq ass8 (* (vlax-safearray-get-element bmatrix n12 n13) (vlax-safearray-get-element cf_node (1+ n13))))
(setq ass7 (+ ass8 ass7))
(setq n13 (1+ n13))
)
(setq ass9 (/ (- (vlax-safearray-get-element bmatrix n12 lenofpoint) ass7) (vlax-safearray-get-element bmatrix n12 n12)))
(vlax-safearray-put-element cf_node (1+ n12) ass9)
(setq n12 (- n12 1))
)
(setq cf_pipe (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)))
(setq n14 (- lenofpipe 1))
(setq n15 1)
(repeat lenofpipe
(setq ass10 (nth 1 (nth n14 pipe_point)))
(setq ass11 (nth 2 (nth n14 pipe_point)))
(setq ass12 (- (vlax-safearray-get-element cf_node ass11) (vlax-safearray-get-element cf_node ass10)))
(setq ass13 (vlax-safearray-put-element cf_pipe n15 ass12))
(setq n14 (- n14 1))
(setq n15 (1+ n15))
)/////////////////////////////////得出管段初分流量的数组cf_pipe
(setq presure 1.5)
(setq presure1 1.2)
(setq arfa (/ (- (expt presure 2) (expt presure1 2)) 10))
(setq n1 1)
(repeat lenofpipe
(setq ass1 (/ (abs (vlax-safearray-get-element cf_pipe n1)) 10000))
(setq ass2 (expt ass1 2))
(setq ass3 (/ arfa ass2))
(setq ass9 (vlax-safearray-put-element pipearfa n1 ass3))
(setq ass4 (gj ass3))
(setq ass5 (vlax-safearray-put-element diaofpipe n1 ass4))
(setq ass6 (vl-position ass5 compd))
(setq ass7 (nth ass6 comparfa))
(setq ass8 (vlax-safearray-put-element coma n1 ass7))
(setq n1 (1+ n1))
)
(setq cp_point '())
(setq n16 lenofpipe)
(repeat lenofpipe
(setq ass14 (vlax-safearray-get-element cf_pipe n16))
(setq n17 (- lenofpipe n16))
(setq ass15 (nth 1 (nth n17 pipe_point)))
(setq ass16 (nth 2 (nth n17 pipe_point)))
(if(< ass14 0)
(progn (setq ass14 '())
(setq ass14 (cons ass15 ass14))
(setq ass14 (cons ass16 ass14))
(setq ass14 (cons n16 ass14))
(setq cp_point (cons ass14 cp_point))
)
(progn (setq ass17 '())
(setq ass17 (cons ass16 ass17))
(setq ass17 (cons ass15 ass17))
(setq ass17 (cons n16 ass17))
(setq cp_point (cons ass17 cp_point))
)
)
(setq n16 (1- n16))
)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;用最小平方和法初分流量
(defun c:yww4 ()
(setq n100 1)
(setq pnode (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint)))
(setq h (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)))
(setq qmatrix (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)))
(setq qmatrix1 (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)))
(setq n0 1)
(repeat lenofpipe
(setq ass0 (/ (vlax-safearray-get-element cf_pipe n0) 10000))
(vlax-safearray-put-element qmatrix1 n0 ass0)
(setq n0 (1+ n0))
)
(setq hmatrix (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)))
(setq eps 0.0001)
(setq cmatrix (vlax-make-safearray
vlax-vbdouble
(cons 1 lenofpipe)
(cons 1 lenofpipe)
)
)
(setq matrix2 (vlax-make-safearray
vlax-vbdouble
(cons 1 num1)
(cons 1 lenofpoint)
)
)
(setq matrix4 (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint)))
(setq rmatrix (vlax-make-safearray
vlax-vbdouble
(cons 1 lenofpoint)
(cons 1 lenofpoint)
)
)
(setq matrix1 (vlax-make-safearray
vlax-vbdouble
(cons 1 lenofpoint)
(cons 1 lenofpipe)
)
)
(vlax-safearray-put-element matrix4 1 0)
(while
(progn
(setq n1 1)
(repeat lenofpipe
(setq ass1 (vlax-safearray-get-element longofpipe n1))
(setq ass2 (abs (vlax-safearray-get-element qmatrix1 n1)))
(setq ass3 (vlax-safearray-get-element coma n1))
(setq ass4 (* ass3 ass2 ass1))
(setq ass5 (/ 1.0 ass4))
(vlax-safearray-put-element cmatrix n1 n1 ass5)
///////////////得出G矩阵
(setq n1 (1+ n1))
)
(setq n2 1)
(repeat lenofpoint
(setq n3 1)
(repeat lenofpipe
(setq n4 1)
(setq ass10 0)
(repeat lenofpipe
(setq ass8 (vlax-safearray-get-element join n2 n4))
(setq ass9 (vlax-safearray-get-element cmatrix n4 n3))
(setq ass10 (+ ass10 (* ass8 ass9)))
(setq n4 (1+ n4))
)
(vlax-safearray-put-element matrix1 n2 n3 ass10)
(setq n3 (1+ n3))
)
(setq n2 (1+ n2))
)
(setq n5 1)
(repeat lenofpoint
(setq n6 1)
(repeat lenofpoint
(setq n7 1)
(setq ass11 0)
(repeat lenofpipe
(setq ass12 (vlax-safearray-get-element matrix1 n5 n7))
(setq ass13 (vlax-safearray-get-element zjoin n7 n6))
(setq ass11 (+ ass11 (* ass12 ass13)))
(setq n7 (1+ n7))
)
(vlax-safearray-put-element rmatrix n5 n6 ass11)
(setq n6 (1+ n6))
)
(setq n5 (1+ n5))
)
(setq num1 (- lenofpoint 1))
(setq n14 1)
(repeat num1
(setq n15 1)
(repeat num1
(setq ass10
(vlax-safearray-get-element rmatrix (1+ n14) (1+ n15))
)
(vlax-safearray-put-element matrix2 n14 n15 ass10)
(setq n15 (1+ n15))
)
(setq n14 (1+ n14))
)
(setq n16 1)
(repeat num1
(setq
ass11 (/ (- 0 (vlax-safearray-get-element q_node (1+ n16)))
10000
)
)
(vlax-safearray-put-element matrix2 n16 lenofpoint ass11)
(setq n16 (1+ n16))
)
(setq n4 1)
(setq num2 (- num1 1))
(repeat num2
(setq maxa 0)
(setq len1 (- lenofpoint n4))
(setq n6 n4)
(repeat len1
(if (> (abs (vlax-safearray-get-element matrix2 n6 n4)) maxa)
(progn
(setq
maxa (abs (vlax-safearray-get-element matrix2 n6 n4))
)
(setq n5 n6)
)
)
(setq n6 (1+ n6))
)
(if (/= n5 n4)
(progn (setq n7 1)
(repeat lenofpoint
(setq ass1 (vlax-safearray-get-element matrix2 n4 n7))
(vlax-safearray-put-element
matrix2
n4
n7
(vlax-safearray-get-element matrix2 n5 n7)
)
(vlax-safearray-put-element matrix2 n5 n7 ass1)
(setq n7 (1+ n7))
)
)
)
(setq n8 (+ n4 1))
(setq len2 (- num1 n4))
(setq len4 (+ 1 len2))
(repeat len2
(setq n9 (1+ n4))
(setq ass3 (vlax-safearray-get-element matrix2 n8 n4))
(setq ass4 (vlax-safearray-get-element matrix2 n4 n4))
(repeat len4
(setq ass1 (vlax-safearray-get-element matrix2 n8 n9))
(setq ass2 (vlax-safearray-get-element matrix2 n4 n9))
(setq ass5 (- ass1 (/ (* ass2 ass3) ass4)))
(vlax-safearray-put-element matrix2 n8 n9 ass5)
(setq n9 (1+ n9))
)
(vlax-safearray-put-element matrix2 n8 n4 0)
(setq n8 (1+ n8))
)
(setq n4 (1+ n4))
)
///////////////////////////////////////////主元素消去法解方程组
(setq
ass6 (/ (vlax-safearray-get-element matrix2 num1 lenofpoint)
(vlax-safearray-get-element matrix2 num1 num1)
)
)
(vlax-safearray-put-element matrix4 lenofpoint ass6)
(setq n12 num2)
(repeat num2
(setq ass7 0)
(setq len2 (- num1 n12))
(setq n13 (1+ n12))
(repeat len2
(setq ass8 (* (vlax-safearray-get-element matrix2 n12 n13)
(vlax-safearray-get-element matrix4 (1+ n13))
)
)
(setq ass7 (+ ass8 ass7))
(setq n13 (1+ n13))
)
(setq ass9
(/ (- (vlax-safearray-get-element matrix2 n12 lenofpoint)
ass7
)
(vlax-safearray-get-element matrix2 n12 n12)
)
)
(vlax-safearray-put-element matrix4 (1+ n12) ass9)
(setq n12 (- n12 1))
)
/////////////////////////////////求得matrix4为节点气压数组
(setq n1 1)
(repeat lenofpipe
(setq ass1 (nth 1 (nth (- n1 1) np_point)))
(setq ass2 (nth 2 (nth (- n1 1) np_point)))
(setq ass3 (vlax-safearray-get-element matrix4 ass1))
(setq ass4 (vlax-safearray-get-element matrix4 ass2))
(setq ass5 (vlax-safearray-get-element cmatrix n1 n1))
(vlax-safearray-put-element hmatrix n1 (- ass3 ass4))
(setq ass6 (* (- ass3 ass4) ass5))
(vlax-safearray-put-element qmatrix n1 ass6)
(setq n1 (1+ n1))
)
(setq n0 1)
(setq maxb 0)
(repeat lenofpipe
(setq ass1 (vlax-safearray-get-element qmatrix n0))
(setq ass2 (vlax-safearray-get-element qmatrix1 n0))
(setq ass3 (abs (- ass1 ass2)))
(if (> ass3 maxb)
(setq maxb ass3)
)
(setq n0 (1+ n0))
)
(> maxb eps)
)
(setq n1 1)
(repeat lenofpipe
(setq ass1 (vlax-safearray-get-element qmatrix n1))
(setq ass2 (vlax-safearray-get-element qmatrix1 n1))
(setq ass3 (/ (+ ass1 ass2) 2))
(vlax-safearray-put-element qmatrix1 n1 ass3)
(setq n1 (1+ n1))
)
(setq n100 (1+ n100))
)
(setq listma4 '())
(setq n3 lenofpoint)
(repeat lenofpoint
(setq ass1 (vlax-safearray-get-element matrix4 n3))
(setq listma4 (cons ass1 listma4))
(setq n3 (1- n3))
)
(setq listma41 (vl-sort-i listma4 '>))
(setq maxhnode (1+(nth 0 listma41)))
(setq n2 1)
(setq ass2 (vlax-safearray-get-element matrix4 maxhnode))
(repeat lenofpoint
(setq ass1 (vlax-safearray-get-element matrix4 n2))
(setq ass4 (expt presure 2))
(setq ass3 (+ ass4 (- ass1 ass2)))
(vlax-safearray-put-element pnode n2 (expt ass3 0.5))
(setq n2 (1+ n2))
);;;;;;;;;;;;;;;;;;;;;;;;;;获得节点气压
/////////////////////////////////////////
(setq nnp_point '())
(setq n16 lenofpipe)
(repeat lenofpipe
(setq ass13 (vlax-safearray-get-element qmatrix n16))
(setq ass15 (nth 1 (nth (1- n16) np_point)))
(setq ass16 (nth 2 (nth (1- n16) np_point)))
(if (< ass13 0)
(progn (setq ass14 '())
(setq ass14 (cons ass15 ass14))
(setq ass14 (cons ass16 ass14))
(setq ass14 (cons n16 ass14))
(setq nnp_point (cons ass14 nnp_point))
)
(progn (setq ass17 '())
(setq ass17 (cons ass16 ass17))
(setq ass17 (cons ass15 ass17))
(setq ass17 (cons n16 ass17))
(setq nnp_point (cons ass17 nnp_point))
)
)
(setq n16 (1- n16))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;用节点法进行平差计算
(defun c:b2()
(setq p1 (getpoint "\n确定节点1:"))
(setq p2 (list(+ 40 (car p1)) (+ 50 (cadr p1))))
(setq p3 (list(+ 40 (car p2)) (cadr p2)))
(setq p6 (list(car p2) (- (cadr p2) 20)))
(command "pline" p1 p2 p3 "")
(command "attdef" "" "1" "2" "3" p2 20 0 "")
(command "attdef" "" "4" "5" "6" p6 20 0 "")
(setq p4 (getpoint "\n选择一点："))
(setq p5 (getpoint "\n选择另一点："))
(setq ss (ssget "c" p4 p5))
(command "block" "jie8" p1 ss "")
)
(defun c:yww10()
(command "-layer" "s" "图形标注" "")
(setq n1 0)
(repeat lenofpoint
(setq ass1 (vlax-safearray-get-element pnode (- lenofpoint n1)))
(setq ass2 (vlax-safearray-get-element q_node1 (- lenofpoint n1)))
(setq sn1 (rtos ass1 2 3))
(setq sn2 (rtos ass2 2 3))
(setq p7 (cdr (nth n1 list2)))
(command "-insert" "jie8" p7 1 1 0 sn2 sn1 "")
(setq n1 (1+ n1))
)
(setq n1 0)
(repeat lenofpipe
(setq pipe (ssname totalpipe n1))
(setq p1 (cdr (assoc 10 (entget pipe))))
(setq p2 (cdr (assoc 11 (entget pipe))))
(setq p0 (mapcar '(lambda (x y) (/ (+ x y) 2)) p1 p2))
/////线段的中点
(setq pipe (vlax-ename->vla-object pipe))
(setq ang1 (* (/ 180 pi) (vla-get-angle pipe)))
(if (and(> ang1 90)(< ang1 270))
(setq ang1 (- ang1 180))
)
(if(= ang1 180)
(setq ang1 0)
)
(if(= ang1 270)
(setq ang1 90)
)
(setq n1 (1+ n1))
(setq ass3 (vlax-safearray-get-element longofpipe n1))
(setq ass4 (vlax-safearray-get-element diaofpipe n1))
(setq sn3 (rtos ass3 2 2))
(setq sn4 (rtos ass4 2 2))
(setq sn5 (strcat sn3 "--" sn4))
(setq ass5 (* 10000 (abs(vlax-safearray-get-element qmatrix n1))))
(setq ass6 (vlax-safearray-get-element hmatrix n1))
(setq sn6 (rtos ass5 2 4))
(setq sn7 (rtos ass6 2 5))
(setq sn8 (strcat sn6 "--" sn7))
(command "text" "j" "bc" p0 20 ang1 sn5)
(command "text" "j" "tc" p0 20 ang1 sn8)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;节点和管段数据的图形标注
//////////////////////////////////////////////////////////////////////////////
(defun c:b1 ()
(setq ass1 (getreal "\n输入标示箭头长度："))
(setq ass2 (getpoint "\n输入箭头起点："))
(setq ass3 (getreal "\n输入起点宽度："))
(setq ass4 (list (+ (car ass2) ass1) (cadr ass2)))
(command "pline" ass2 "w" ass3 0 ass4 "")
(command "block" "block1" ass2 (entlast) "")
)
(defun c:yww7 ()
(command "-layer" "s" "流向标注" "")
(setq n1 0)
(repeat lenofpipe
(setq pipe1 (ssname totalpipe n1))
(setq p1 (cdr (assoc 10 (entget pipe1))))
(setq p2 (cdr (assoc 11 (entget pipe1))))
(setq p3x (/ (+ (car p1) (car p2)) 2))
(setq p3y (/ (+ (cadr p1) (cadr p2)) 2))
(setq p3 (list p3x p3y))
(setq pipe2 (vlax-ename->vla-object pipe1))
(setq ass2 (* (/ 180 pi) (vla-get-angle pipe2)))
(setq ass3 (nth 1 (nth (- lenofpipe n1 1) pipe_point)))
(setq ass4 (nth 1 (nth n1 nnp_point)))
(if (= ass3 ass4)
(setq ass5 ass2)
(setq ass5 (- 0 (- 180 ass2)))
)
(command "-insert" "block1" p3 1 1 ass5)
(setq n1 (1+ n1))
)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管段流量方向的标注

(vl-load-com) 
(defun gj (par_q) 
  (setq  ll (cond    
     ((and (< par_q 338.75) (> par_q 40.70)) 100) 
     ((and (< par_q 40.70) (> par_q 9.05)) 150) 
     ((and (< par_q 9.05) (> par_q 4.89)) 200) 
     ((and (< par_q 4.89) (> par_q 2.82)) 225) 
     ((and (< par_q 2.82) (> par_q 1.09)) 250) 
     ((and (< par_q 1.09) (> par_q 0.486)) 300) 
     ((and (< par_q 0.486) (> par_q 0.242)) 350) 
     ((and (< par_q 0.242) (> par_q 0.131)) 400) 
     ((and (< par_q 0.131) (> par_q 0.0753)) 450) 
     ((and (< par_q 0.0753) (> par_q 0.0291)) 500) 
     ((and (< par_q 0.0291) (> par_q 0.0130)) 600) 
     ((and (< par_q 0.0130) (> par_q 0.00646)) 700) 
     ((and (< par_q 0.00646) (> par_q 0.00349)) 800) 
     ) 
  ) 
) 
(setq compd '(100 150 200 225 250 300 350 400 450 500 600 700 800 900 1000 1200)) 
(setq comparfa '(338.75 40.70 9.05 4.89 2.82 1.09 0.486 0.242 0.131 0.0753 0.0291 0.0130  0.00646 0.00349 0.00201 0.0007764)) 
 (defun zh (p) 
  (setq m1 (rtos (car p) 2 2)) 
  (setq m2 (rtos (cadr p) 2 2)) 
  (setq m3 (rtos (caddr p) 2 2)) 
  (strcat m1 "," m2 "," m3) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;把坐标转化为字符串的形式 
/////////////////////////////////////////////////////////////////////////// 
(defun zh1 (p) 
  (setq m1 (rtos (car p) 2 2)) 
  (setq m2 (rtos (cadr p) 2 2)) 
  (setq m3 (rtos (caddr p) 2 2)) 
  (strcat m1 " " m2 " " m3) 
) 
/////////////////////////////////////////////////////////////////////////// 
(defun c:yww8 () 
  (setq totalpipe (ssget "x" (list (cons 0 "line")))) 
  //////////totalpipe所有管线的集合 
  (setq lenofpipe (sslength totalpipe)) 
  //////////////////////lenofpipe管段数 
  (setq totalpoint '()) 
  (setq n1 0) 
  (repeat lenofpipe 
    (setq pipe (ssname totalpipe n1)) 
    (setq p1 (cdr (assoc 10 (entget pipe)))) 
    (if  (= (vl-position p1 totalpoint) nil) 
      (setq totalpoint (cons p1 totalpoint)) 
    ) 
    (setq p2 (cdr (assoc 11 (entget pipe)))) 
    (if  (= (vl-position p2 totalpoint) nil) 
      (setq totalpoint (cons p2 totalpoint)) 
    ) 
    (setq n1 (1+ n1)) 
  ) 
  (setq lenofpoint (length totalpoint)) 
  (setq num1 (- lenofpoint 1)) 
  (setq n2 0) 
  (setq list2 '()) 
  (repeat lenofpoint 
    (setq p3 (nth n2 totalpoint)) 
    (setq str1 (zh p3)) 
    (setq n2 (1+ n2)) 
    (setq list2 (cons (cons n2 p3) list2)) 
  ) 
  (setq dfn1 (open "f:/程序设计/管网计算/wen3.txt" "w")) 
  (setq n3 0) 
  (setq pipe_point '()) 
  (repeat lenofpipe 
    (setq ass0 '()) 
    (setq n4 0) 
    (setq n5 0) 
    (setq s1 (ssname totalpipe n3)) 
    (setq sn3 (rtos (+ 1 n3) 2 0)) 
    (setq p1 (cdr (assoc 10 (entget s1)))) 
    (repeat lenofpoint 
      (setq plist2 (nth n4 list2)) 
      (if (and (= (nth 1 plist2) (nth 0 p1)) 
         (= (nth 2 plist2) (nth 1 p1)) 
         (= (nth 3 plist2) (nth 2 p1)) 
    ) 
  (progn (setq sp1 (rtos (nth 0 plist2) 2 0)) 
         (setq ass2 (nth 0 plist2)) 
  ) 
      ) 
      (setq n4 (1+ n4)) 
    ) 
    (setq p2 (cdr (assoc 11 (entget s1)))) 
    (repeat lenofpoint 
      (setq plist2 (nth n5 list2)) 
      (if (and (= (nth 1 plist2) (nth 0 p2)) 
         (= (nth 2 plist2) (nth 1 p2)) 
         (= (nth 3 plist2) (nth 2 p2)) 
    ) 
  (progn (setq sp2 (rtos (nth 0 plist2) 2 0)) 
         (setq ass3 (nth 0 plist2)) 
  ) 
      ) 
      (setq n5 (1+ n5)) 
    ) 
    (setq str2 (strcat sn3 " " sp1 " " sp2)) 
    (setq ass0 (cons ass3 ass0)) 
    (setq ass0 (cons ass2 ass0)) 
    (setq ass0 (cons n3 ass0)) 
    (setq pipe_point (cons ass0 pipe_point)) 
    (write-line str2 dfn1) 
    (setq n3 (1+ n3)) 
  ) 
  (setq np_point '()) 
  (setq n16 lenofpipe) 
  (repeat lenofpipe 
    (setq n17 (- lenofpipe n16)) 
    (setq ass15 (nth 1 (nth n17 pipe_point))) 
    (setq ass16 (nth 2 (nth n17 pipe_point))) 
    (setq ass14 '()) 
    (setq ass14 (cons ass16 ass14)) 
    (setq ass14 (cons ass15 ass14)) 
    (setq ass14 (cons n16 ass14)) 
    (setq np_point (cons ass14 np_point)) 
    (setq n16 (1- n16)) 
  ) 
  (setq n1 lenofpoint) 
  (setq point_pipe '()) 
  (repeat lenofpoint 
    (setq n2 (- lenofpipe 1)) 
    (setq ass2 '()) 
    (repeat lenofpipe 
      (setq ass1 (nth n2 np_point)) 
      (if (or (= (nth 1 ass1) n1) (= (nth 2 ass1) n1)) 
  (progn (setq ass3 (nth 0 ass1)) 
         (setq ass2 (cons ass3 ass2)) 
  ) 
      ) 
      (setq n2 (- n2 1)) 
    ) 
    (setq ass2 (cons n1 ass2)) 
    (setq point_pipe (cons ass2 point_pipe)) 
    (setq n1 (- n1 1)) 
  ) 
    (setq  join (vlax-make-safearray 
         vlax-vbdouble 
         (cons 1 lenofpoint) 
         (cons 1 lenofpipe) 
       ) 
  ) 
  (setq n3 0) 
  (setq n5 1) 
  (repeat lenofpoint 
    (setq ass4 (nth n3 point_pipe)) 
    (setq len3 (- (length ass4) 1)) 
    (setq n4 1) 
    (repeat len3 
      (setq ass5 (nth n4 ass4)) 
      (setq ass6 (nth (- ass5 1) np_point)) 
      (setq ass7 (nth 1 ass6)) 
      (if (= ass7 n5) 
  (vlax-safearray-put-element join n5 ass5 1) 
  (vlax-safearray-put-element join n5 ass5 -1) 
      ) 
      (setq n4 (1+ n4)) 
    ) 
    (setq n5 (1+ n5)) 
    (setq n3 (1+ n3)) 
  ) 
  (setq  zjoin (vlax-make-safearray 
    vlax-vbdouble 
    (cons 1 lenofpipe) 
    (cons 1 lenofpoint) 
        ) 
  ) 
  (setq n8 1) 
  (repeat lenofpipe 
    (setq n9 1) 
    (repeat lenofpoint 
      (setq ass12 (vlax-safearray-get-element join n9 n8)) 
      (vlax-safearray-put-element zjoin n8 n9 ass12) 
      (setq n9 (1+ n9)) 
    ) 
    (setq n8 (1+ n8)) 
  ) 
  (setq  longofpipe 
   (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)) 
  )////////////////////////////////////////////////定义管段长度数组 
  (setq q_node1 
   (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint)) 
  )////////////////////////////////////////////////定义节点流量 
  (setq q_node 
   (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint)) 
  ) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管网拓扑信息的提取 
(defun c:yww1 () 
  //////////pipe 
  n1 
  lenofpipe 
  totalpoint 
  p1 
  p2 
  p0 
  ang1 
 
  (command "-layer" "s" "管段号" "") 
  (setq n1 0) 
  (repeat lenofpipe 
    (setq pipe (ssname totalpipe n1)) 
    (setq p1 (cdr (assoc 10 (entget pipe)))) 
    (setq p2 (cdr (assoc 11 (entget pipe)))) 
    (setq p0 (mapcar '(lambda (x y) (/ (+ x y) 2)) p1 p2)) 
    (setq pipe (vlax-ename->vla-object pipe)) 
    (setq ang1 (* (/ 180 pi) (vla-get-angle pipe))) 
    (if (and(> ang1 90)(< ang1 270)) 
        (setq ang1 (- ang1 180)) 
    ) 
    (if(= ang1 180) 
       (setq ang1 0) 
    ) 
    (if(= ang1 270) 
       (setq ang1 90) 
    ) 
    (setq n1 (1+ n1)) 
    (command "text" p0 35 ang1 (rtos n1 2 0)) 
  ) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管段编号并标注 
(defun c:yww2 () 
  ////////dfn 
  lenofpoint 
  n2 
  p3 
  str1 
  (setvar "cmdecho" 0) 
  (command "-layer" "s" "节点号" "") 
  (setq dfn (open "f:/程序设计/管网计算/wen1.txt" "w")) 
  ///////输入节点坐标到文本中 
  (setq n2 0) 
  (repeat lenofpoint 
    (setq p3 (nth n2 totalpoint)) 
    (command "circle" p3 35) 
    (setq str1 (zh1 p3)) 
    (setq str1 (strcat (rtos (1+ n2) 2 0) " " str1)) 
    (write-line str1 dfn) 
    (setq n2 (1+ n2)) 
    (command "text" "j" "mc" p3 30 0 (rtos n2 2 0)) 
  ) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;节点编号并标注 
(defun c:yww11() 
  (initget 1 "A B") 
  (setq ass1 (getkword "选择方式/A(调用文本)/B(用户输入):")) 
  (if(= ass1 "A") 
      (progn(setq filename (getfiled "原始数据文本" "" "txt" 2)) 
            (setq ptfile (open filename "r")) 
            (setq n1 1) 
            (repeat lenofpipe 
                (setq pp (read-line ptfile)) 
                (setq pp1 (read(strcat "(" pp ")"))) 
                
          (vlax-safearray-put-element longofpipe n1 (nth 4 pp1)) 
                (setq n1 (1+ n1)) 
            ) 
      ) 
      (progn(setq n2 1) 
            (repeat lenofpipe 
                 (setq ass2 (rtos n2 2 2)) 
           (setq ass3 (getreal (strcat "\n输入" ass2 "管长:" ))) 
                 (vlax-safearray-put-element diaofpipe n2 ass1) 
           (vlax-safearray-put-element longofpipe n2 ass3) 
                 (setq n2 (1+ n2)) 
            ) 
      ) 
  ) 
  //////////////////////////////////////////////得出管段长度数组longofpipe                                              
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管段长度的获得 
(defun c:yww23() 
     (setq filename1 (getfiled "节点流量文本" "" "txt" 2)) 
     (setq ptfile1 (open filename1 "r")) 
     (setq n1 1) 
     (repeat lenofpoint 
          (setq pp1 (read-line ptfile1)) 
          (setq pp0 (read(strcat "(" pp1 ")"))) 
          (vlax-safearray-put-element q_node n1 (nth 4 pp0)) 
          (vlax-safearray-put-element q_node1 n1 (nth 4 pp0)) 
          (setq n1 (1+ n1)) 
     ) 
    
 );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;调用文本得到节点流量 
(defun c:yww3()//////n1 n2 n3 ss1 main s_joint p2 p3 sub 
  (setq diaofpipe 
   (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe)) 
  ) 
  (setq coma (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))) 
  (setq pipearfa (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))) 
  (setq n1 1) 
  (setq ylen (1+ lenofpoint)) 
  (setq amatrix (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint)(cons 1 ylen))) 
  (repeat lenofpoint 
     (setq n2 (- n1 1)) 
     (setq p1 (nth n2 totalpoint)) 
     (setq ss1 (ssget "x" (list (cons -4 "<or") 
             (cons -4 "<and") 
             (cons 0 "line")(cons 10 p1) 
             (cons -4 "and>") 
                               (cons -4 "<and") 
             (cons 0 "line")(cons 11 p1) 
             (cons -4 "and>") 
             (cons -4 "or>") 
         ) 
         ) 
     ) 
    (setq main (sslength ss1)) 
    (setq n3 0) 
    (repeat main 
        (setq s_joint (ssname ss1 n3)) 
        (setq n3 (1+ n3)) 
        (setq p2 (cdr(assoc 10 (entget s_joint)))) 
        (setq p3 (cdr(assoc 11 (entget s_joint)))) 
        (if (or(/= (car p1)(car p2))(/= (cadr p1)(cadr p2))) 
      (progn(setq sub (vl-position p2 totalpoint)) 
            (setq sub (1+ sub)) 
            (vlax-safearray-put-element amatrix n1 sub -1) 
            ) 
  ) 
        (if (or(/= (car p1)(car p3))(/= (cadr p1)(cadr p3))) 
      (progn(setq sub (vl-position p3 totalpoint)) 
            (setq sub (1+ sub)) 
            (vlax-safearray-put-element amatrix n1 sub -1) 
            ) 
  ) 
    ) 
    (vlax-safearray-put-element amatrix n1 n1 main) 
    (setq n1 (1+ n1)) 
  ) 
 (setq n4 1) 
  (setq num1 (- lenofpoint 1)) 
  (setq bmatrix (vlax-make-safearray vlax-vbdouble (cons 1 num1)(cons 1 lenofpoint))) 
  (setq n1 1) 
  (repeat lenofpoint 
        (setq ass1 (vlax-safearray-get-element q_node n1)) 
        (vlax-safearray-put-element amatrix n1 ylen ass1) 
        (setq n1 (1+ n1)) 
  ) 
  (setq n14 1) 
  (repeat num1 
      (setq n15 1) 
      (repeat lenofpoint 
         (setq ass10 (vlax-safearray-get-element amatrix (1+ n14) (1+ n15))) 
         (vlax-safearray-put-element bmatrix n14 n15 ass10) 
         (setq n15 (1+ n15)) 
      ) 
      (setq n14 (1+ n14)) 
  ) 
  (setq n4 1) 
  (setq num2 (- num1 1)) 
  (repeat num2 
       (setq maxa 0) 
       (setq len1 (- lenofpoint n4)) 
       (setq n6 n4) 
       (repeat len1 
          (if (> (abs(vlax-safearray-get-element bmatrix n6 n4)) maxa) 
        (progn(setq maxa (abs(vlax-safearray-get-element bmatrix n6 n4))) 
                    (setq n5 n6) 
         ) 
          ) 
          (setq n6 (1+ n6)) 
       ) 
       (if(/= n5 n4) 
    (progn(setq n7 1) 
      (repeat lenofpoint 
        (setq ass1 (vlax-safearray-get-element bmatrix n4 n7)) 
        (vlax-safearray-put-element bmatrix n4 n7 (vlax-safearray-get-element bmatrix n5 n7)) 
        (vlax-safearray-put-element bmatrix n5 n7 ass1) 
        (setq n7 (1+ n7)) 
      ) 
    ) 
       ) 
       (setq n8 (+ n4 1)) 
       (setq len2 (- num1 n4)) 
       (setq len4 (+ 1 len2)) 
       (repeat len2 
             (setq n9 (1+ n4)) 
       (setq ass3 (vlax-safearray-get-element bmatrix n8 n4)) 
             (setq ass4 (vlax-safearray-get-element bmatrix n4 n4)) 
       (repeat len4 
                 (setq ass1 (vlax-safearray-get-element bmatrix n8 n9)) 
     (setq ass2 (vlax-safearray-get-element bmatrix n4 n9)) 
           (setq ass5 (- ass1 (/ (* ass2 ass3) ass4))) 
     (vlax-safearray-put-element bmatrix n8 n9 ass5) 
           (setq n9 (1+ n9)) 
       ) 
       (vlax-safearray-put-element bmatrix n8 n4 0) 
             (setq n8 (1+ n8)) 
        ) 
        (setq n4 (1+ n4)) 
  ) 
  (setq cf_node (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint))) 
  (setq ass6 (/ (vlax-safearray-get-element bmatrix num1 lenofpoint) (vlax-safearray-get-element bmatrix num1 num1))) 
  (vlax-safearray-put-element cf_node lenofpoint ass6) 
  (setq n12 num2) 
  (repeat num2 
        (setq ass7 0) 
        (setq len2 (- num1 n12)) 
        (setq n13 (1+ n12)) 
        (repeat len2 
      (setq ass8 (* (vlax-safearray-get-element bmatrix n12 n13) (vlax-safearray-get-element cf_node (1+ n13)))) 
            (setq ass7 (+ ass8 ass7)) 
      (setq n13 (1+ n13)) 
  ) 
        (setq ass9 (/ (- (vlax-safearray-get-element bmatrix n12 lenofpoint) ass7) (vlax-safearray-get-element bmatrix n12 n12))) 
  (vlax-safearray-put-element cf_node (1+ n12) ass9) 
        (setq n12 (- n12 1)) 
  ) 
  (setq cf_pipe (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))) 
  (setq n14 (- lenofpipe 1)) 
  (setq n15 1) 
  (repeat lenofpipe 
         (setq ass10 (nth 1 (nth n14 pipe_point))) 
         (setq ass11 (nth 2 (nth n14 pipe_point))) 
         (setq ass12 (- (vlax-safearray-get-element cf_node ass11) (vlax-safearray-get-element cf_node ass10))) 
         (setq ass13 (vlax-safearray-put-element cf_pipe n15 ass12)) 
         (setq n14 (- n14 1)) 
         (setq n15 (1+ n15)) 
  )/////////////////////////////////得出管段初分流量的数组cf_pipe 
  (setq presure 1.5) 
  (setq presure1 1.2) 
  (setq arfa (/ (- (expt presure 2) (expt presure1 2)) 10)) 
  (setq n1 1) 
  (repeat lenofpipe 
      (setq ass1 (/ (abs (vlax-safearray-get-element cf_pipe n1)) 10000)) 
      (setq ass2 (expt ass1 2)) 
      (setq ass3 (/ arfa ass2)) 
      (setq ass9 (vlax-safearray-put-element pipearfa n1 ass3)) 
      (setq ass4 (gj ass3)) 
      (setq ass5 (vlax-safearray-put-element diaofpipe n1 ass4)) 
      (setq ass6 (vl-position ass5 compd)) 
      (setq ass7 (nth ass6 comparfa)) 
      (setq ass8 (vlax-safearray-put-element coma n1 ass7)) 
      (setq n1 (1+ n1)) 
  ) 
   
  (setq cp_point '()) 
  (setq n16 lenofpipe) 
  (repeat lenofpipe 
       (setq ass14 (vlax-safearray-get-element cf_pipe n16)) 
       (setq n17 (- lenofpipe n16)) 
       (setq ass15 (nth 1 (nth n17 pipe_point))) 
       (setq ass16 (nth 2 (nth n17 pipe_point))) 
       (if(< ass14 0) 
            (progn (setq ass14 '()) 
                   (setq ass14 (cons ass15 ass14)) 
             (setq ass14 (cons ass16 ass14)) 
             (setq ass14 (cons n16 ass14)) 
             (setq cp_point (cons ass14 cp_point)) 
      ) 
     (progn (setq ass17 '()) 
                  (setq ass17 (cons ass16 ass17)) 
            (setq ass17 (cons ass15 ass17)) 
            (setq ass17 (cons n16 ass17)) 
            (setq cp_point (cons ass17 cp_point)) 
     ) 
       ) 
       (setq n16 (1- n16)) 
  ) 
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;用最小平方和法初分流量 
(defun c:yww4 () 
  (setq n100 1) 
  (setq pnode (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint))) 
  (setq h (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))) 
  (setq qmatrix (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))) 
  (setq qmatrix1 (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))) 
   (setq n0 1) 
  (repeat lenofpipe 
    (setq ass0 (/ (vlax-safearray-get-element cf_pipe n0) 10000)) 
    (vlax-safearray-put-element qmatrix1 n0 ass0) 
    (setq n0 (1+ n0)) 
  ) 
  (setq hmatrix (vlax-make-safearray vlax-vbdouble (cons 1 lenofpipe))) 
  (setq eps 0.0001) 
  (setq  cmatrix  (vlax-make-safearray 
      vlax-vbdouble 
      (cons 1 lenofpipe) 
      (cons 1 lenofpipe) 
    ) 
  ) 
  (setq  matrix2  (vlax-make-safearray 
      vlax-vbdouble 
      (cons 1 num1) 
      (cons 1 lenofpoint) 
    ) 
  ) 
  (setq matrix4 (vlax-make-safearray vlax-vbdouble (cons 1 lenofpoint))) 
  (setq  rmatrix  (vlax-make-safearray 
      vlax-vbdouble 
      (cons 1 lenofpoint) 
      (cons 1 lenofpoint) 
    ) 
  ) 
  (setq  matrix1  (vlax-make-safearray 
      vlax-vbdouble 
      (cons 1 lenofpoint) 
      (cons 1 lenofpipe) 
    ) 
  ) 
  (vlax-safearray-put-element matrix4 1 0) 
  (while 
    (progn 
      (setq n1 1) 
      (repeat lenofpipe 
  (setq ass1 (vlax-safearray-get-element longofpipe n1)) 
  (setq ass2 (abs (vlax-safearray-get-element qmatrix1 n1))) 
  (setq ass3 (vlax-safearray-get-element coma n1)) 
  (setq ass4 (* ass3 ass2 ass1)) 
  (setq ass5 (/ 1.0 ass4)) 
  (vlax-safearray-put-element cmatrix n1 n1 ass5) 
  ///////////////得出G矩阵 
  (setq n1 (1+ n1)) 
      ) 
      (setq n2 1) 
      (repeat lenofpoint 
  (setq n3 1) 
  (repeat  lenofpipe 
    (setq n4 1) 
    (setq ass10 0) 
    (repeat lenofpipe 
      (setq ass8 (vlax-safearray-get-element join n2 n4)) 
      (setq ass9 (vlax-safearray-get-element cmatrix n4 n3)) 
      (setq ass10 (+ ass10 (* ass8 ass9))) 
      (setq n4 (1+ n4)) 
    ) 
    (vlax-safearray-put-element matrix1 n2 n3 ass10) 
    (setq n3 (1+ n3)) 
  ) 
  (setq n2 (1+ n2)) 
      ) 
      (setq n5 1) 
      (repeat lenofpoint 
  (setq n6 1) 
  (repeat  lenofpoint 
    (setq n7 1) 
    (setq ass11 0) 
    (repeat lenofpipe 
      (setq ass12 (vlax-safearray-get-element matrix1 n5 n7)) 
      (setq ass13 (vlax-safearray-get-element zjoin n7 n6)) 
      (setq ass11 (+ ass11 (* ass12 ass13))) 
      (setq n7 (1+ n7)) 
    ) 
    (vlax-safearray-put-element rmatrix n5 n6 ass11) 
    (setq n6 (1+ n6)) 
  ) 
  (setq n5 (1+ n5)) 
      ) 
      (setq num1 (- lenofpoint 1)) 
      (setq n14 1) 
      (repeat num1 
  (setq n15 1) 
  (repeat  num1 
    (setq  ass10 
     (vlax-safearray-get-element rmatrix (1+ n14) (1+ n15)) 
    ) 
    (vlax-safearray-put-element matrix2 n14 n15 ass10) 
    (setq n15 (1+ n15)) 
  ) 
  (setq n14 (1+ n14)) 
      ) 
      (setq n16 1) 
      (repeat num1 
  (setq 
    ass11  (/ (- 0 (vlax-safearray-get-element q_node (1+ n16))) 
       10000 
    ) 
  ) 
  (vlax-safearray-put-element matrix2 n16 lenofpoint ass11) 
  (setq n16 (1+ n16)) 
      ) 
      (setq n4 1) 
      (setq num2 (- num1 1)) 
      (repeat num2 
  (setq maxa 0) 
  (setq len1 (- lenofpoint n4)) 
  (setq n6 n4) 
  (repeat  len1 
    (if (> (abs (vlax-safearray-get-element matrix2 n6 n4)) maxa) 
      (progn 
        (setq 
    maxa (abs (vlax-safearray-get-element matrix2 n6 n4)) 
        ) 
        (setq n5 n6) 
 
      ) 
    ) 
    (setq n6 (1+ n6)) 
  ) 
  (if (/= n5 n4) 
    (progn (setq n7 1) 
     (repeat lenofpoint 
       (setq ass1 (vlax-safearray-get-element matrix2 n4 n7)) 
       (vlax-safearray-put-element 
         matrix2 
         n4 
         n7 
         (vlax-safearray-get-element matrix2 n5 n7) 
       ) 
       (vlax-safearray-put-element matrix2 n5 n7 ass1) 
       (setq n7 (1+ n7)) 
     ) 
    ) 
  ) 
  (setq n8 (+ n4 1)) 
  (setq len2 (- num1 n4)) 
  (setq len4 (+ 1 len2)) 
  (repeat  len2 
    (setq n9 (1+ n4)) 
    (setq ass3 (vlax-safearray-get-element matrix2 n8 n4)) 
    (setq ass4 (vlax-safearray-get-element matrix2 n4 n4)) 
    (repeat len4 
      (setq ass1 (vlax-safearray-get-element matrix2 n8 n9)) 
      (setq ass2 (vlax-safearray-get-element matrix2 n4 n9)) 
      (setq ass5 (- ass1 (/ (* ass2 ass3) ass4))) 
      (vlax-safearray-put-element matrix2 n8 n9 ass5) 
      (setq n9 (1+ n9)) 
    ) 
    (vlax-safearray-put-element matrix2 n8 n4 0) 
    (setq n8 (1+ n8)) 
  ) 
  (setq n4 (1+ n4)) 
      ) 
      ///////////////////////////////////////////主元素消去法解方程组 
      (setq 
  ass6 (/  (vlax-safearray-get-element matrix2 num1 lenofpoint) 
    (vlax-safearray-get-element matrix2 num1 num1) 
       ) 
      ) 
      (vlax-safearray-put-element matrix4 lenofpoint ass6) 
      (setq n12 num2) 
      (repeat num2 
  (setq ass7 0) 
  (setq len2 (- num1 n12)) 
  (setq n13 (1+ n12)) 
  (repeat  len2 
    (setq  ass8 (*  (vlax-safearray-get-element matrix2 n12 n13) 
      (vlax-safearray-get-element matrix4 (1+ n13)) 
         ) 
    ) 
    (setq ass7 (+ ass8 ass7)) 
    (setq n13 (1+ n13)) 
  ) 
  (setq ass9 
         (/ (- (vlax-safearray-get-element matrix2 n12 lenofpoint) 
         ass7 
      ) 
      (vlax-safearray-get-element matrix2 n12 n12) 
         ) 
  ) 
  (vlax-safearray-put-element matrix4 (1+ n12) ass9) 
  (setq n12 (- n12 1)) 
      ) 
      /////////////////////////////////求得matrix4为节点气压数组 
      (setq n1 1) 
      (repeat lenofpipe 
  (setq ass1 (nth 1 (nth (- n1 1) np_point))) 
  (setq ass2 (nth 2 (nth (- n1 1) np_point))) 
  (setq ass3 (vlax-safearray-get-element matrix4 ass1)) 
  (setq ass4 (vlax-safearray-get-element matrix4 ass2)) 
  (setq ass5 (vlax-safearray-get-element cmatrix n1 n1)) 
  (vlax-safearray-put-element hmatrix n1 (- ass3 ass4)) 
  (setq ass6 (* (- ass3 ass4) ass5)) 
  (vlax-safearray-put-element qmatrix n1 ass6) 
  (setq n1 (1+ n1)) 
      ) 
      (setq n0 1) 
      (setq maxb 0) 
      (repeat lenofpipe 
  (setq ass1 (vlax-safearray-get-element qmatrix n0)) 
  (setq ass2 (vlax-safearray-get-element qmatrix1 n0)) 
  (setq ass3 (abs (- ass1 ass2))) 
  (if (> ass3 maxb) 
    (setq maxb ass3) 
  ) 
  (setq n0 (1+ n0)) 
      ) 
      (> maxb eps) 
    ) 
     (setq n1 1) 
     (repeat lenofpipe 
       (setq ass1 (vlax-safearray-get-element qmatrix n1)) 
       (setq ass2 (vlax-safearray-get-element qmatrix1 n1)) 
       (setq ass3 (/ (+ ass1 ass2) 2)) 
       (vlax-safearray-put-element qmatrix1 n1 ass3) 
       (setq n1 (1+ n1)) 
     ) 
     (setq n100 (1+ n100)) 
  ) 
  (setq listma4 '()) 
  (setq n3 lenofpoint) 
  (repeat lenofpoint 
     (setq ass1 (vlax-safearray-get-element matrix4 n3)) 
     (setq listma4 (cons ass1 listma4)) 
     (setq n3 (1- n3)) 
  ) 
  (setq listma41 (vl-sort-i listma4 '>)) 
  (setq maxhnode (1+(nth 0 listma41))) 
  (setq n2 1) 
  (setq ass2 (vlax-safearray-get-element matrix4 maxhnode)) 
  (repeat lenofpoint 
     (setq ass1 (vlax-safearray-get-element matrix4 n2)) 
     (setq ass4 (expt presure 2)) 
     (setq ass3 (+ ass4 (- ass1 ass2))) 
     (vlax-safearray-put-element pnode n2 (expt ass3 0.5)) 
     (setq n2 (1+ n2)) 
  );;;;;;;;;;;;;;;;;;;;;;;;;;获得节点气压 
  ///////////////////////////////////////// 
  (setq nnp_point '()) 
  (setq n16 lenofpipe) 
  (repeat lenofpipe 
    (setq ass13 (vlax-safearray-get-element qmatrix n16)) 
 
    (setq ass15 (nth 1 (nth (1- n16) np_point))) 
    (setq ass16 (nth 2 (nth (1- n16) np_point))) 
    (if  (< ass13 0) 
      (progn (setq ass14 '()) 
       (setq ass14 (cons ass15 ass14)) 
       (setq ass14 (cons ass16 ass14)) 
       (setq ass14 (cons n16 ass14)) 
       (setq nnp_point (cons ass14 nnp_point)) 
      ) 
      (progn (setq ass17 '()) 
       (setq ass17 (cons ass16 ass17)) 
       (setq ass17 (cons ass15 ass17)) 
       (setq ass17 (cons n16 ass17)) 
       (setq nnp_point (cons ass17 nnp_point)) 
      ) 
    ) 
    (setq n16 (1- n16)) 
  ) 
) 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;用节点法进行平差计算 
(defun c:b2() 
   (setq p1 (getpoint "\n确定节点1:")) 
   (setq p2 (list(+ 40 (car p1)) (+ 50 (cadr p1)))) 
   (setq p3 (list(+ 40 (car p2)) (cadr p2))) 
   (setq p6 (list(car p2) (- (cadr p2) 20))) 
   (command "pline" p1 p2 p3 "") 
   (command "attdef" "" "1" "2" "3" p2 20 0 "") 
   (command "attdef" "" "4" "5" "6" p6 20 0 "") 
   (setq p4 (getpoint "\n选择一点：")) 
   (setq p5 (getpoint "\n选择另一点：")) 
   (setq ss (ssget "c" p4 p5)) 
   (command "block" "jie8" p1 ss "") 
) 
(defun c:yww10() 
   (command "-layer" "s" "图形标注" "") 
   (setq n1 0) 
   (repeat lenofpoint 
      (setq ass1 (vlax-safearray-get-element pnode (- lenofpoint n1))) 
      (setq ass2 (vlax-safearray-get-element q_node1 (- lenofpoint n1))) 
      (setq sn1 (rtos ass1 2 3)) 
      (setq sn2 (rtos ass2 2 3)) 
      (setq p7 (cdr (nth n1 list2))) 
      (command "-insert" "jie8" p7 1 1 0 sn2 sn1 "") 
      (setq n1 (1+ n1)) 
   ) 
  (setq n1 0) 
  (repeat lenofpipe 
    (setq pipe (ssname totalpipe n1)) 
    (setq p1 (cdr (assoc 10 (entget pipe)))) 
    (setq p2 (cdr (assoc 11 (entget pipe)))) 
    (setq p0 (mapcar '(lambda (x y) (/ (+ x y) 2)) p1 p2)) 
    /////线段的中点 
    (setq pipe (vlax-ename->vla-object pipe)) 
    (setq ang1 (* (/ 180 pi) (vla-get-angle pipe))) 
    (if (and(> ang1 90)(< ang1 270)) 
        (setq ang1 (- ang1 180)) 
    ) 
    (if(= ang1 180) 
       (setq ang1 0) 
    ) 
    (if(= ang1 270) 
       (setq ang1 90) 
    ) 
    (setq n1 (1+ n1)) 
    (setq ass3 (vlax-safearray-get-element longofpipe n1)) 
    (setq ass4 (vlax-safearray-get-element diaofpipe n1)) 
    (setq sn3 (rtos ass3 2 2)) 
    (setq sn4 (rtos ass4 2 2)) 
    (setq sn5 (strcat sn3 "--" sn4)) 
    (setq ass5 (* 10000 (abs(vlax-safearray-get-element qmatrix n1)))) 
    (setq ass6 (vlax-safearray-get-element hmatrix n1)) 
    (setq sn6 (rtos ass5 2 4)) 
    (setq sn7 (rtos ass6 2 5)) 
    (setq sn8 (strcat sn6 "--" sn7)) 
    (command "text"  "j" "bc" p0 20 ang1 sn5) 
    (command "text"  "j" "tc" p0 20 ang1 sn8) 
  ) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;节点和管段数据的图形标注 
////////////////////////////////////////////////////////////////////////////// 
(defun c:b1 () 
  (setq ass1 (getreal "\n输入标示箭头长度：")) 
  (setq ass2 (getpoint "\n输入箭头起点：")) 
  (setq ass3 (getreal "\n输入起点宽度：")) 
  (setq ass4 (list (+ (car ass2) ass1) (cadr ass2))) 
  (command "pline" ass2 "w" ass3 0 ass4 "") 
  (command "block" "block1" ass2 (entlast) "") 
) 
 (defun c:yww7 () 
  (command "-layer" "s" "流向标注" "") 
  (setq n1 0) 
  (repeat lenofpipe 
    (setq pipe1 (ssname totalpipe n1)) 
    (setq p1 (cdr (assoc 10 (entget pipe1)))) 
    (setq p2 (cdr (assoc 11 (entget pipe1)))) 
    (setq p3x (/ (+ (car p1) (car p2)) 2)) 
    (setq p3y (/ (+ (cadr p1) (cadr p2)) 2)) 
    (setq p3 (list p3x p3y)) 
    (setq pipe2 (vlax-ename->vla-object pipe1)) 
    (setq ass2 (* (/ 180 pi) (vla-get-angle pipe2))) 
    (setq ass3 (nth 1 (nth (- lenofpipe n1 1) pipe_point))) 
    (setq ass4 (nth 1 (nth n1 nnp_point))) 
    (if  (= ass3 ass4) 
      (setq ass5 ass2) 
      (setq ass5 (- 0 (- 180 ass2))) 
    ) 
    (command "-insert" "block1" p3 1 1 ass5) 
    (setq n1 (1+ n1)) 
  ) 
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管段流量方向的标注

xuyan769078907 · 发表于 2012-6-6 10:54:02

在什么资料里拷贝的啊？！
~~~

zyhandw · 发表于 2012-6-6 11:45:52

程序表面上看不出有什么问题！看提示，是不是哪个地方数据转换出了问题，或是提供的对象有误？

知行ooo李肖坪 · 发表于 2016-1-9 12:27:42

同步学习中…………

账号		自动登录	找回密码
密码			注册

求助：从资料里粘贴的平差程序，运行不了，求高人指点！！！

浏览过的版块