[LISP函数]：怎么获得多义线某分段的长度

雨箭风刀

感觉上的确如你所说,一般是用数学方法保险(vlisp程序库里面有函数),在此不多说.
但我也想过,如果 是用在程序里面应该没有问题,(entsel和osnap应该是对应的)如果是用在函数里面,那么就还是用求的办法. :P

fsxm

从下面的各位老大们抄袭后就出来了:

2. 
   
3. (vl-load-com)
   
4. (defun subSEG2 (ent pt / cen len lst p1 p2 pam pam1 pam2 r sd)
   
5.   (setq        pt   (vlax-curve-getclosestpointto ent pt)
   
6.         pam1 (fix (vlax-curve-getparamatpoint ent pt))
   
7.         pam2 (1+ pam1)
   
8.         p1   (vlax-curve-getpointatparam ent pam1)
   
9.         p2   (vlax-curve-getpointatparam ent pam2)
   
10.         len  (-        (vlax-curve-getdistatparam ent pam2)
    
11.                 (vlax-curve-getdistatparam ent pam1)
    
12.              )
    
13.         pam  (vlax-curve-getparamatpoint ent pt)
    
14.         sd   (vlax-curve-getsecondderiv ent pam)
    
15.   )
    
16.   (if (equal sd '(0 0 0))
    
17.     (list '(0 . "line")
    
18.           (cons "stp" p1)
    
19.           (cons "enp" p2)
    
20.           (cons "len" len)
    
21.     )
    
22.     (setq cen (mapcar
    
23.                 (if (> (vla-getbulge (vlax-ename->vla-object ent) pam1) 0)
    
24.                   '+
    
25.                   '-
    
26.                 )
    
27.                 pt
    
28.                 sd              )
    
29.           r   (distance sd '(0 0 0))
    
30.           lst (list '(0 . "arc")
    
31.                     (cons "cen" cen)
    
32.                     (cons "r" r)
    
33.                     (cons "stp" p1)
    
34.                     (cons "enp" p2)
    
35.                     (cons "len" len)
    
36.               )
    
37.     )
    
38.   )
    
39. )
    
40. (defun c:tt ()
    
41.   (mapcar 'print (apply 'subseg2 (entsel)))
    
42.   (princ)
    
43. )
    

<br /> (vl-load-com)<br /> (defun subSEG2 (ent pt / cen len lst p1 p2 pam pam1 pam2 r sd)<br />   (setq        pt   (vlax-curve-getclosestpointto ent pt)<br />         pam1 (fix (vlax-curve-getparamatpoint ent pt))<br />         pam2 (1+ pam1)<br />         p1   (vlax-curve-getpointatparam ent pam1)<br />         p2   (vlax-curve-getpointatparam ent pam2)<br />         len  (-        (vlax-curve-getdistatparam ent pam2)<br />                 (vlax-curve-getdistatparam ent pam1)<br />              )<br />         pam  (vlax-curve-getparamatpoint ent pt)<br />         sd   (vlax-curve-getsecondderiv ent pam)<br />   )<br />   (if (equal sd '(0 0 0))<br />     (list '(0 . "line")<br />           (cons "stp" p1)<br />           (cons "enp" p2)<br />           (cons "len" len)<br />     )<br />     (setq cen (mapcar<br />                 (if (> (vla-getbulge (vlax-ename->vla-object ent) pam1) 0)<br />                   '+<br />                   '-<br />                 )<br />                 pt<br />                 sd              )<br />           r   (distance sd '(0 0 0))<br />           lst (list '(0 . "arc")<br />                     (cons "cen" cen)<br />                     (cons "r" r)<br />                     (cons "stp" p1)<br />                     (cons "enp" p2)<br />                     (cons "len" len)<br />               )<br />     )<br />   )<br /> )<br /> (defun c:tt ()<br />   (mapcar 'print (apply 'subseg2 (entsel)))<br />   (princ)<br /> )<br />

xyp1964

功能：标注多义线各段线长（包括圆弧）
快捷命令：xcbz

xyp1964

效果：

kohi

不用那么复杂吧？
[php]
(defun c:test ()
  (setq a (entsel "Pick Polyline:"))
  (setq p (vlax-curve-getclosestpointto (car a)(trans (cadr a) 1 0)))
  (setq n (fix (vlax-curve-getparamatpoint (car a) p)))
  (- (vlax-curve-getDistAtParam (car a)(1+ n))
     (vlax-curve-getDistAtParam (car a) n))
)
[/php]

fsxm

不用那么复杂???
你再细看看为什么要这么复杂
(cons "cen" cen)
(cons "r" r)
(cons "stp" p1)
(cons "enp" p2)
(cons "len" len)
这不只是求分段长了还有起点终点圆心的信息

kohi

21楼:
"1楼楼主说：[LISP函数]：怎么获得多义线某分段的长度"

lzp1986

试了一楼和十三楼的，都不好用？

hhc_1

试了一下,20楼kohi的很好,如果只求长度足够了.不过写法需改进,那个(car a)出现了4次,要用一个变量储存(car a)的值