求标注曲线（主要是多段线）两点之间的线长的插件

清风明月10

我想求一个标注多段线两点之间的长度的插件，这个多段线可以有直线，也可以弧线。当然也可以是针对所有曲线的插件。
我主要是碰到一个问题，例如读匝道的里程时，由于匝道的弯曲半径很小，所以读它的里程如果直接用垂直距离，误差会很大，如果是用两点间多段线的长度，则是从理论上来说，一点误差也没有的

st788796

清风明月10 发表于 2014-3-8 08:29
这就是示例。如果直接量垂直线距离，则是极不准确的。非得计算两点之间的多段线长并标出来才是准确的。
...

搞不清你要标哪

1. (defun c:tt (/ e p1 p2 dis dim)
   
2.   (if (setq e (car (xdrx_entsel
   
3.                      "\nPick Curve: "
   
4.                      '((0 . "*line,arc,circle,ellipse"))
   
5.                    )
   
6.               )
   
7.       )
   
8.     (while (and        (setq p1 (getpoint "\nFirst Point On Curve: "))
   
9.                 (XD::Doc:DrawCrossHair
   
10.                   (setq p1 (xdrx_curve_getclosestpoint e p1))
    
11.                   (/ pi 4)
    
12.                   0.1
    
13.                 )
    
14.                 (setq p2 (getpoint p1 "\nSecond Point On Curve: "))
    
15.            )
    
16.       (setq
    
17.         dis (rtos (abs (xdrx_curve_getdistatpoint
    
18.                          e
    
19.                          p1
    
20.                          (setq p2 (xdrx_curve_getclosestpoint e p2))
    
21.                        )
    
22.                   )
    
23.                   2
    
24.                   3
    
25.             )
    
26.       )
    
27.       (setq dim        (xdrx_dimension_makerotate
    
28.                   p1
    
29.                   p2
    
30.                   (polar (xdrx_line_midp p1 p2)
    
31.                          (+ (angle p1 p2) (/ pi 2))
    
32.                          (* 3. (getvar "dimscale") (getvar "dimtxt"))
    
33.                   )
    
34.                   (angle p1 p2)
    
35.                 )
    
36.       )
    
37.       (xdrx_setpropertyvalue dim "DimText" dis)
    
38.     )
    
39.   )
    
40.   (princ)
    
41. )
    

(defun c:tt (/ e p1 p2 dis dim)<br />   (if (setq e (car (xdrx_entsel<br />                      "\nPick Curve: "<br />                      '((0 . "*line,arc,circle,ellipse"))<br />                    )<br />               )<br />       )<br />     (while (and        (setq p1 (getpoint "\nFirst Point On Curve: "))<br />                 (XD::Doc:DrawCrossHair<br />                   (setq p1 (xdrx_curve_getclosestpoint e p1))<br />                   (/ pi 4)<br />                   0.1<br />                 )<br />                 (setq p2 (getpoint p1 "\nSecond Point On Curve: "))<br />            )<br />       (setq<br />         dis (rtos (abs (xdrx_curve_getdistatpoint<br />                          e<br />                          p1<br />                          (setq p2 (xdrx_curve_getclosestpoint e p2))<br />                        )<br />                   )<br />                   2<br />                   3<br />             )<br />       )<br />       (setq dim        (xdrx_dimension_makerotate<br />                   p1<br />                   p2<br />                   (polar (xdrx_line_midp p1 p2)<br />                          (+ (angle p1 p2) (/ pi 2))<br />                          (* 3. (getvar "dimscale") (getvar "dimtxt"))<br />                   )<br />                   (angle p1 p2)<br />                 )<br />       )<br />       (xdrx_setpropertyvalue dim "DimText" dis)<br />     )<br />   )<br />   (princ)<br /> )<br />

st788796

附图上来  

清风明月10

st788796 发表于 2014-3-7 23:10
附图上来

这就是示例。如果直接量垂直线距离，则是极不准确的。非得计算两点之间的多段线长并标出来才是准确的。

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:福永互通匝道路基平面图四月读A、C匝道里程偏移.rar 
下载次数:13  文件大小:728.3 KB 
下载权限: 不限 以上  [免费赚D豆]

清风明月10

谢谢你！我试了，能够得到正确的长度！

清风明月10

st788796 发表于 2014-3-7 23:10
附图上来

请问老师，我想改造一下，将标注炸开，直到标注里面的文字为单行文字，电脑怎么总提示列表有缺陷啊？请教应该如何改造？
(defun c:tt (/ e p1 p2 dis dim)
  ; 来源：2楼 晓东CAD家园-论坛-技术问答【悬赏求助】-求标注曲线（主要是多段线）两点之间的线长的插件 - Powered by Discuz!
; http://www.xdcad.net/forum/forum ... read&tid=672847
  (if (setq e (car (xdrx_entsel
                     "\nPick Curve: "
                     '((0 . "*line,arc,circle,ellipse"))
                   )
              )
      )
    (while (and        (setq p1 (getpoint "\nFirst Point On Curve: "))
                (XD::Doc:DrawCrossHair
                  (setq p1 (xdrx_curve_getclosestpoint e p1))
                  (/ pi 4)
                  0.1
                )
                (setq p2 (getpoint p1 "\nSecond Point On Curve: "))
           )
      (setq
        dis (rtos (abs (xdrx_curve_getdistatpoint
                         e
                         p1
                         (setq p2 (xdrx_curve_getclosestpoint e p2))
                       )
                  )
                  2
                  3
            )
      )
      (setq dim        (xdrx_dimension_makerotate
                  p1
                  p2
                  (polar (xdrx_line_midp p1 p2)
                         (+ (angle p1 p2) (/ pi 2))
                         (* 3. (getvar "dimscale") (getvar "dimtxt"))
                  )
                  (angle p1 p2)
                )
      )
      (xdrx_setpropertyvalue dim "DimText" dis)
          
          (command ".EXPLODE" (entlast) "" )
         ( progn
          (setq A 0)
  (setq ss (ssget "P"))
  (SETQ A (SSLENGTH SS))   
(SETQ 第几个 0)
(while (< 第几个 a)
(setq 图元名 (ssname SS 第几个))
(command ".explode" 图元名 "")     
(setq 第几个 (+ 第几个 1))
)
);progn结束
          
    )
  )
  (princ)
)

st788796

(setq ss (xdrx_entity_explode t dim t))
(mapcar '(lambd (x) (if (wcmatch (xdrx_getpropertyvalue x "IsA") "*Text") (xdrx_entity_explode t t x nil))) (xdrx_pickset->ents ss))

daobuledeniu

老师:我复制代码保存为类lsp文件后，在2011cad里加载这个程序后标注不了，是怎么回事？求指点！！！