如何查看Visual LISP生成的安全数组或矩阵？！

xuyan769078907

(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))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;管网拓扑信息的提取

菡萏

这一长串代码不发也罢！谁有兴趣去分析你的程序？
安全数组数据转换论坛里有很多示例代码！
参见
http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=201

xuyan769078907

菡萏 发表于 2012-6-8 11:39
这一长串代码不发也罢！谁有兴趣去分析你的程序？
安全数组数据转换论坛里有很多示例代码！
参见

谢谢！！呵呵~~我是新手，很多都不懂！！请谅解了