求多段线上任意间距点至别一条多段线的垂直距离，并将距离输出至记事本或excel中

spring8801

如图所示，以A线为基准线，求B线任意间距点（手动输入间距）至A线的距离，B线上的点在A线右侧为正值，左侧为负值。并将距离按照顺序输出记事本或excel中。

jpg102329

1. (defun c:tt(/ +- A B CAN DIST ET INT LST PTA PTLST X)
   
2.   (setq a(car(jc-entsel'((0 . "*polyline"))"点选A线")))
   
3.   (setq b(jc-entsel'((0 . "*polyline"))"点选B线"))
   
4.   (setq can(if(>(* 0.5 (jc-len(car b)))(vlax-curve-getDistAtPoint (car b)(apply'vlax-curve-getclosestpointto b)))""))
   
5.   (initget 3)
   
6.   (setq dist(getdist"间距："))
   
7.   (setq ptlst(jc-定距等分坐标表 (car b) dist can))
   
8.   (setq int 0)
   
9.   (setq lst
   
10.   (mapcar'(lambda(x)
    
11.         (setq pta(vlax-curve-getclosestpointto a x))
    
12.         (setq dist(distance pta x))
    
13.         (setq +-(if(>(car pta)(car x))"+""-"))
    
14.       (list
    
15.         (rtos(setq int(1+ int))2 0)
    
16.         (strcat +- (rtos dist))
    
17.         )
    
18.       )ptlst))
    
19.   (jc-line ptlst (mapcar '(lambda(x)(vlax-curve-getclosestpointto a x)) ptlst))
    
20.     (if(not(or(setq et(vlax-get-or-create-object"ket.application"))(setq et(vlax-get-or-create-object"et.application"))(setq et(vlax-get-or-create-object"excel.application"))))
    
21.   (progn(alert"未找到WPS或MSexcel")(exit)))
    
22.   (vla-put-visible et 1)
    
23.   (vlax-invoke(vlax-get-property ET 'WorkBooks)'Add);建工作薄
    
24.   (JC-EXCEL-PASE et "A1"lst)
    
25.   (prompt"***大懒猪荣誉出品***")
    
26.   (princ)
    
27.   )
    

(defun c:tt(/ +- A B CAN DIST ET INT LST PTA PTLST X)<br />   (setq a(car(jc-entsel'((0 . "*polyline"))"点选A线")))<br />   (setq b(jc-entsel'((0 . "*polyline"))"点选B线"))<br />   (setq can(if(>(* 0.5 (jc-len(car b)))(vlax-curve-getDistAtPoint (car b)(apply'vlax-curve-getclosestpointto b)))""))<br />   (initget 3)<br />   (setq dist(getdist"间距："))<br />   (setq ptlst(jc-定距等分坐标表 (car b) dist can))<br />   (setq int 0)<br />   (setq lst<br />   (mapcar'(lambda(x)<br />         (setq pta(vlax-curve-getclosestpointto a x))<br />         (setq dist(distance pta x))<br />         (setq +-(if(>(car pta)(car x))"+""-"))<br />       (list<br />         (rtos(setq int(1+ int))2 0)<br />         (strcat +- (rtos dist))<br />         )<br />       )ptlst))<br />   (jc-line ptlst (mapcar '(lambda(x)(vlax-curve-getclosestpointto a x)) ptlst))<br />     (if(not(or(setq et(vlax-get-or-create-object"ket.application"))(setq et(vlax-get-or-create-object"et.application"))(setq et(vlax-get-or-create-object"excel.application"))))<br />   (progn(alert"未找到WPS或MSexcel")(exit)))<br />   (vla-put-visible et 1)<br />   (vlax-invoke(vlax-get-property ET 'WorkBooks)'Add);建工作薄<br />   (JC-EXCEL-PASE et "A1"lst)<br />   (prompt"***大懒猪荣誉出品***")<br />   (princ)<br />   )<br />

jpg102329

如果可用，请记得给我回复说一句我的答案能用，版主看到你的回复会把明经币扣给我的。挣点明经币不容易啊，望理解

spring8801

jpg102329 发表于 2017-8-17 09:07
如果可用，请记得给我回复说一句我的答案能用，版主看到你的回复会把明经币扣给我的。挣点明经币不容易啊， ...

"错误: no function definition: JC-LEN"请问这是什么原因？

spring8801

spring8801 发表于 2017-8-17 13:26
"错误: no function definition: JC-LEN"请问这是什么原因？

可以用了，程序必须先加载TTP.lsp程序，再加载上面的代码吗？而且先后顺序不能更改么？

jpg102329

spring8801 发表于 2017-8-17 13:41
可以用了，程序必须先加载TTP.lsp程序，再加载上面的代码吗？而且先后顺序不能更改么？

因为整体文件有点多，所以贴出来的代码只是主程序，子函数都在TTP.LSP中，包括主程序也在，网页上的部分代码在TTP.LSP文件中已经存在，可以直接使用。希望版主可以把钱付给我哈哈，写代码不容易

jpg102329

上午看的时候你还只有5个明经币呢，怎么这会儿就17个了，你是怎么弄到的啊

itoboy

jpg102329 发表于 2017-8-17 14:00
上午看的时候你还只有5个明经币呢，怎么这会儿就17个了，你是怎么弄到的啊

估计是用激情、贡献之类兑换的

spring8801

itoboy 发表于 2017-8-18 21:58
估计是用激情、贡献之类兑换的

说的对，是兑换的

spring8801

jpg102329 发表于 2017-8-17 14:00
因为整体文件有点多，所以贴出来的代码只是主程序，子函数都在TTP.LSP中，包括主程序也在，网页上的部分 ...

可以用了，都是版主才能给你么？我不在上面直接点付给你么？