直线分段辅助LISP

arker

这几天领导要根据一些地形高程点绘制地形图，领导把相近的高程点连接起来，根据高程数据差分得出整数高程点，再手动连接等高程的点。个人感觉连线后找到整数高程点属于重复劳动，就写了一小段解决，希望对各位有所帮助。（本人还是2004年左右学了一点，喜欢东拼西凑，不太愿意仔细研究，写出来的东西很粗浅，欢迎各位指导。）
(defun c:tt()
  (setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
  (setq en (car (entsel "\n选取线：")))
  (setq endata (entget en))
  (setq pt_10 (cdr (assoc 10 endata)))
  (setq pt_11 (cdr (assoc 11 endata)))
  (setq ang (angle pt_10 pt_11))
  (setq dd (distance pt_10 pt_11))
  (setq bas1 pt_10)
(setq G1 (getreal "\n请输入1点高程:"))
(setq G2 (getreal "\n请输入2点高程:"))
(setq i (fix G1))
(while (<= i (- (fix G2) 1)) (setq i (+ i 1))
  (setq scal (* dd (/ (- i G1) (- G2 G1))))
    (setq bas2 (polar bas1 ang scal))
    (setq P3 (polar bas2 (+ ang 1.571) 10))
   (command "line" P3 bas2  "")
)
(setvar "osmode" os)
  (prin1)
  )
;程序说明：
;1、该程序为等高线辅助程序。
;2、需用line命令连接两个已有高程点，从低的高程往高的高程连接。
;3、此问题已解决。关于捕捉打开关闭问题。
;4、加载时 从cad 工具--加载应用程序--找到本程序并加载。
;5、输入tt命令启动程序。
;6、 Edited by Kar 2019.02.08。

arker

当时为了展点，也写了一个展点的小lisp，这跟已有坐标数据和层厚（高程）数据是相关联的（excel按规律准备好）。感觉上两个小程序可以结合一下，另外第一条程序应该可以加一些小判断更优化点。

(vl-load-com)
(defun *error* (msg)
  
  (princ "\n")
  (princ)
  
)  
(defun c:chou (/ sum pt tt hc)
   (initget 1)
(setq tt (getint "\n请输入字体高度: "))
(setq pt (getpoint "\n请拾取起点位置："))

(setq acadObject (vlax-get-acad-object))
(setq acadDocument (vla-get-ActiveDocument acadObject))
(setq mSpace (vla-get-ModelSpace acadDocument))


(setq string (vlax-make-variant TtopNumber vlax-vbstring ))

(while (listp pt)

(setq hc (getstring "\n请输入该点层厚: "))
(progn
(setq NewText (vla-addtext mSpace hc (vlax-3d-point pt) tt))
(princ  "\n")
(princ  n)
(princ  "目前层厚为:")
(princ  hc)
)


(initget "End")
    (setq pt (getpoint "\n请输入下一个点，结束输入E/<pick point>:"))   
     )
)
(princ "层厚统计程序成功调入！  ***键入 chou 运行***")
(prin1)

lhmlhmlhm21

谢谢你的分享，要是有动图演示就更好啦

coverne

谢谢你的分享

arker

lhmlhmlhm21 发表于 2019-2-9 09:37
谢谢你的分享，要是有动图演示就更好啦

我刚刚来 还不知道怎么弄动图

arker

C:\Users\Lenovo\Desktop\1549681646(1).jgp
图中左侧两根线为使用前使用后的对比，右边是已经用了的一些情况。

arker

作为原来学过html语言的，居然不会上图。

newer

arker 发表于 2019-2-9 11:11
作为原来学过html语言的，居然不会上图。

你点发帖按钮， 高级模式， 里面有个按钮“图片”， 选上硬盘的图片文件，点上传就行了

Lisphk

楼主，是不是生成三角网，然后再生成等高线更方便些

                               
登录/注册后可看大图

• 生成三角网，查询高程
  7 个回复 - 302 次查看
  
  
  2017-5-27 11:40 - Lisphk - A/VLISP
• 【拓扑检查】点线矛盾(基于三角网，速度快）（第一版）
  12 个回复 - 75 次查看
  等高线图层 (setq lyr-dgx "dgx,等高线") 自己修改引号内符合自己需要 如发现矛盾 品红色标记---- 平三角形内不符合 黄色标记 ---- 不等高三维面内不符合 **** 本内容被作者隐藏 ****
  2019-1-23 16:44 - Lispboy - 每日插件
• 等高线生成三角网
  12 个回复 - 104 次查看
  **** 本内容被作者隐藏 ****
  2019-1-23 17:05 - Lispboy - 每日插件
• 生成三角网
  72 个回复 - 1609 次查看
  运行在 XDRX API 2017.10.30+ **** 本内容被作者隐藏 ****
  2017-10-30 17:45 - newer - 每日插件
• C#绘制三角网完整工程
  129 个回复 - 1814 次查看
  **** 本内容被作者隐藏 ****
  2016-9-1 10:47 - CSharpBoy - VB.NET/C#
• 网格标高（根据三角网批量生成）
  12 个回复 - 220 次查看
  1、批量根据三角网，生成网格交点的三个高程值（现状、设计、施工），属性块，根据需要去编辑另外两个高程 2、使用了新的进度条技术，有效防止大量操作时候，ACAD假死，其他技术的工具条体现不了实际进度的毛病 ...
  2018-9-26 16:04 - newer - 每日插件
• 三角网绘制等高线
  82 个回复 - 4210 次查看
  如图，绘制等高线 **** 本内容被作者隐藏 ****
  2016-2-26 08:32 - csharp - VB.NET/C#
  
  

arker

Lisphk 发表于 2019-2-9 12:41
楼主，是不是生成三角网，然后再生成等高线更方便些

感谢，感觉您提供的是我一直想学的，就是内容复杂，自己能懂的部分太少。希望有时间好好学习。

arker

附图为两个小程序的过程：excel数据为原始数据，包含坐标点，高程数据，整理后得最后一列，为：坐标和高程竖向排列。在cad输入chou命令后将该部分数据粘贴进去，就得到了地形（高程点）情况。 最后一幅图为 连线作业情况，最终勾连出地形图。   方法原始，但对于我个人来说十分容易理解和操作。

newer

arker 发表于 2019-2-9 13:58
附图为两个小程序的过程：excel数据为原始数据，包含坐标点，高程数据，整理后得最后一列，为：坐标和高程 ...

请把你的EXCEL文件，和成果DWG文件 压缩，传上来，看看。

arker

newer 发表于 2019-2-9 14:05
请把你的EXCEL文件，和成果DWG文件 压缩，传上来，看看。

刚刚重新测试了一次，输入 chou  命令进行展点的时候需要输入字高，然后就把excel最后一列复制了直接粘贴到cad输入命令处就行。
至于 tt 命令，则是点一条直线，输入两个高程就可以了。

arker

刚刚excel没保存，空的

zhystar

谢谢楼主分享知识