求高人写横断面垂直移动到线上程序

jhzlx · 发表于 2017-9-6 19:35:37

请您解决，谢谢谢谢！

f4800 · 发表于 2022-3-27 20:08:03

;程序－移动高程点至断面线上
;程序较小,附源码,有注释
(DEFUN C:TT () (C:MGC))
( defun C:MGC (  /  pt sl pd) ; 垂直移动高程点到断面线上的程序，
; appload 加载后，运行 mgc 命令即可，The pro- gram written by wang shaowen
( setq  sl  ( entsel "\n选择横断直线:" ) )
( if ( null vlax-dump-object) ( vl-load-com) )  ; 加载 vlax 扩展函数
( setq sl ( vlax-ename->vla-object ( car sl) ) )  ; 转换直线为 vla 对象
( setq en T) ;  对象为 T 值，t 为常量，非 NiL 值 ( while en ; 循环语句
( while( not ( setq en ( entsel" \n选择高程点 [Esc退出]:" ) ) ) ); 循环选择，过滤空选
( setq en_data ( entget ( car en) ) ); 取得元体资料列表
( setq pt ( cdr ( assoc 10 en_data) ) ); 求得高程点坐标 pt
( setq  pd ( vlax-curve-getclosestpointto  sl pt) ); 求出直线上距选择点最近的点
( setq  pd1 ( list ( car pd )  ( cadr pd )  ( caddr pt) ) ); 改变 Z 值，避免 0 值
( command "_move" en "" pt pd1)
(princ)
)
(prompt "\n高程点垂直移动到横断直线 [MGC/TT]"  )
(princ)

jhzlx · 发表于 2017-9-6 22:28:47

言戲無軍发表于 2017-9-6 22:09
一个选择函数，一个求最近点函数，在一个移动函数就行了

请你写下程序

jhzlx · 发表于 2017-9-14 15:17:50

13648893846 发表于 2017-9-12 23:27
CASS不是就有这功能吗？

cass有这个功能，但不能批量

言戲無軍 · 发表于 2017-9-6 22:09:02

一个选择函数，一个求最近点函数，在一个移动函数就行了

言戲無軍 · 发表于 2017-9-6 22:36:26

jhzlx 发表于 2017-9-6 22:28
请你写下程序

论坛大神多，有人会写的

jhzlx · 发表于 2017-9-7 18:49:31

期待大神

jhzlx · 发表于 2017-9-8 10:16:44

高手请进。

言戲無軍 · 发表于 2017-9-10 15:33:25

写的粗糙，貌似可用

13648893846 · 发表于 2017-9-12 23:27:51

CASS不是就有这功能吗？

jhzlx · 发表于 2017-9-14 15:15:06

言戲無軍发表于 2017-9-10 15:33
写的粗糙，貌似可用

谢谢。命令是？

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

[源码] 求高人写横断面垂直移动到线上程序

本帖子中包含更多资源

本帖子中包含更多资源