一种快速求场地平均高程的好方法》的程序改进

hanniu_1973 · 发表于 2015-10-20 12:21:22

各位朋友：你们好！这是我在《测绘通报》（2005年第4期，P66）看到杨双富发表的“对《一种快速求场地平均高程的好方法》的程序改进”之例程，程序清单如下：

;;快速求场地的平均高程：
(defun c:gc()
 (setq wl nil)
 (command "3dpoly");画所求范围的闭合线
 (while(setq pt (getpoint))
(setq wl (append wl(list pt)))
(command pt)
 )
 (command "c" "chprop" (entlast) "" "c" 1 "");将闭合线的颜色设为红色
 (setq plen (entlast))
 (setq ss (ssget "_wp" wl'((0."TEXT"))))
 (setq n (sslength ss)
i 0
sum 0
)
(repeat n
 (setq db (entget(ssname ss i))
 sum (+ sum(read(cdr(assoc l db))));提取高程值并累加
 i (1+i)
 )
)
 (setq pjg (strcat"平均高程＝"(rtos(/sum n)))
nds (strcat"高程点数="(itoa n))
pt1 (getpoint"\ n 请选择计算结果写入点：")
pt2 (mapcar'+ pt1'(0 20 0))
)
 (command "text" pt1 4 0 pjg
 "text" pt2 4 0 nds
 "erase" plen "" "redraw";删除所求范围的闭合线)
 )
)

不知是哪里出错，运行时老是提示如下：

命令: gc 3dpoly
指定多段线的起点:
指定直线的端点或 [放弃(U)]:
指定直线的端点或 [放弃(U)]:
指定直线的端点或 [闭合(C)/放弃(U)]:
指定直线的端点或 [闭合(C)/放弃(U)]:
指定直线的端点或 [闭合(C)/放弃(U)]:
指定直线的端点或 [闭合(C)/放弃(U)]:
c
命令: chprop
选择对象: 找到 1 个
选择对象:
输入要更改的特性 [颜色(C)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/材质(M)/注释性(A)]: c
新颜色 [真彩色(T)/配色系统(CO)] <BYLAYER>: 1
输入要更改的特性 [颜色(C)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/材质(M)/注释性(A)]:
命令: ; 错误: ssget 列表错误

希望各位朋友批评指正，谢谢！

yshf · 发表于 2015-10-20 20:19:22

将(setq ss (ssget "_wp" wl'((0."TEXT"))))改为(setq ss (ssget "_wp" wl '((0 . "TEXT"))))，
由排版的原因，那刊物上漏了好多空格，正确的如下，自己去比较：

;;快速求场地的平均高程：
(defun c:gc()
(setq wl nil)
(command "3dpoly");画所求范围的闭合线
(while (setq pt (getpoint))
(setq wl (append wl (list pt)))
(command pt)
)
(command "c" "chprop" (entlast) "" "c" 1 "");将闭合线的颜色设为红色
(setq plen (entlast))
(setq ss (ssget "_wp" wl '((0 . "TEXT"))))
(setq n (sslength ss)
i 0
sum 0
)
(repeat n
(setq db (entget (ssname ss i))
sum (+ sum (read (cdr (assoc l db))));提取高程值并累加
i (1+ i)
)
)
(setq pjg (strcat "平均高程＝" (rtos (/ sum n)))
nds (strcat "高程点数=" (itoa n))
pt1 (getpoint "\ n 请选择计算结果写入点：")
pt2 (mapcar '+ pt1 '(0 20 0))
)
(command "text" pt1 4 0 pjg
"text" pt2 4 0 nds
"erase" plen "" "redraw";删除所求范围的闭合线)
)
)

;;快速求场地的平均高程： 
(defun c:gc() 
     (setq wl nil) 
     (command "3dpoly");画所求范围的闭合线 
     (while (setq pt (getpoint)) 
         (setq wl (append wl (list pt))) 
         (command pt) 
     ) 
     (command "c" "chprop" (entlast) "" "c" 1 "");将闭合线的颜色设为红色 
     (setq plen (entlast)) 
     (setq ss (ssget "_wp" wl '((0 . "TEXT")))) 
     (setq n (sslength ss) 
           i 0 
           sum 0 
      ) 
      (repeat n 
          (setq db (entget (ssname ss i)) 
               sum (+ sum (read (cdr (assoc l db))));提取高程值并累加 
               i   (1+ i) 
          ) 
     ) 
     (setq pjg (strcat "平均高程＝" (rtos (/ sum n))) 
           nds (strcat "高程点数=" (itoa n)) 
           pt1 (getpoint "\ n 请选择计算结果写入点：") 
           pt2 (mapcar '+ pt1 '(0 20 0)) 
     ) 
     (command "text" pt1 4 0 pjg 
              "text" pt2 4 0 nds 
              "erase" plen "" "redraw";删除所求范围的闭合线) 
     ) 
)

hanniu_1973 · 发表于 2015-10-21 18:00:16

杨工：你好！我复制你的代码过去运行还是出现如下提示：

命令: gc 3dpoly
指定多段线的起点:
指定直线的端点或 [放弃(U)]:
指定直线的端点或 [放弃(U)]:
指定直线的端点或 [闭合(C)/放弃(U)]:
指定直线的端点或 [闭合(C)/放弃(U)]:
c
命令: chprop
选择对象: 找到 1 个

选择对象:
输入要更改的特性 [颜色(C)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/材质(M)/注释性(A)]: c
新颜色 [真彩色(T)/配色系统(CO)] <BYLAYER>: 1
输入要更改的特性 [颜色(C)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/材质(M)/注释性(A)]:
命令: ; 错误: 参数类型错误: stringp nil

究竟哪里出问题了呢？麻烦你帮我看一看，谢谢！

yshf · 发表于 2015-10-21 19:50:37

你图中要求平均值的高程是以单行文字的形式出现，并且插入点表示该点的平面位置、数字文本表示高程值。没有图，也不好判断，要不你将图发到HRYCLY@126.com中，我看一下。

hanniu_1973 · 发表于 2015-10-22 10:39:57

求平均高程图已发你的126邮箱，请查收并帮瞧一瞧，哪里出了问题，谢谢！

yshf · 发表于 2015-10-22 20:53:20

已发到你邮箱中，请查看。

lht · 发表于 2015-10-24 10:56:47

提供一个新思路,把所有界线内的等高线沿边界封闭,复制一组等高线并将高程全部置0,然后放样成实体,合并全部实体,得到实体体积,将体积除边界面积即为边界内地形的平均高程.

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

[源码] 一种快速求场地平均高程的好方法》的程序改进

相关帖子

本帖子中包含更多资源