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
        ( setqsl( 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选择高程点 :" ) ) ) ); 循环选择，过滤空选
        ( setq en_data ( entget ( car en) ) ); 取得元体资料列表
        ( setq pt ( cdr ( assoc 10 en_data) ) ); 求得高程点坐标 pt
        ( setqpd ( vlax-curve-getclosestpointtosl pt) ); 求出直线上距选择点最近的点
        ( setqpd1 ( list ( car pd )( cadr pd )( caddr pt) ) ); 改变 Z 值，避免 0 值
        ( command "_move" en "" pt pd1)
        (princ)       
)
(prompt "\n高程点垂直移动到横断直线 ")       
(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
写的粗糙，貌似可用

谢谢。命令是？
页: [1] 2 3
查看完整版本: 求高人写横断面垂直移动到线上程序