點選多段線生成5m或10m dtmpoint點至txt檔

ivde

hastan 发表于 2015-10-4 12:27
做的到就可以

现学了下 G 版的 RxApi

需要G版的 API 库
尚需优化，输出自己增加

2. 
   
3. (defun c:tt (/ ss dis ps box ss v pb sss m n p0 pls pts _pi2 trilst)
   
4.   (if (and (setq dis (getdist "\nDistance of Axis: "))
   
5.            (setq ps (ssget "+.:S" '((0 . "*Polyline"))))
   
6.            (setq pl (ssname ps 0))
   
7.            (setq pls (xlrx-curve-getstretchpoints pl))
   
8.            (setq ss (ssget "x" '((0 . "insert") (2 . "99"))))
   
9.            (setq sss (XLRX-TriAngle ss ps nil t))
   
10.       )
    
11.     (progn
    
12.       (setq box           (list (apply 'mapcar (cons 'min pls))
    
13.                          (apply 'mapcar (cons 'max pls))
    
14.                    )
    
15.             v           (mapcar 'abs (apply 'mapcar (cons '- box)))
    
16.             pb           (car box)
    
17.             m           (fix (/ (car v) dis))
    
18.             n           (fix (/ (cadr v) dis))
    
19.             p0           pb
    
20.             trilst (mapcar 'xlrx-curve-getstretchpoints
    
21.                            (xlrx-pickset->list sss)
    
22.                    )
    
23.       )
    
24.       (repeat m
    
25.         (setq pts (cons (setq p0 (polar p0 0.0 dis)) pts))
    
26.       )
    
27.       (setq pts         (cons pb (reverse pts))
    
28.             _pi2 (/ pi 2)
    
29.       )
    
30.       (mapcar
    
31.         '(lambda (b / stri)
    
32.            (if (setq stri
    
33.                       (vl-member-if
    
34.                         '(lambda (c)
    
35.                            (apply 'xlrx-point-getTriIntersElev (cons b c))
    
36.                          )
    
37.                         trilst
    
38.                       )
    
39.                )
    
40.              (apply 'xlrx-point-getTriIntersElev (cons b (car stri)));_能计算高程的点
    
41.              (entmake (list '(0 . "point") (cons 10 b)));_三角网外部的点
    
42.            )
    
43.          )
    
44.         (apply
    
45.           'append
    
46.           (mapcar '(lambda (x / p ptl)
    
47.                      (setq p x)
    
48.                      (repeat n
    
49.                        (setq ptl (cons (setq p (polar p _pi2 dis)) ptl))
    
50.                      )
    
51.                      (vl-remove-if
    
52.                        '(lambda        (a)
    
53.                           (not (XLRX-Point-IsInPoly1 a pls))
    
54.                         )
    
55.                        (cons x (reverse ptl))
    
56.                      )
    
57.                    )
    
58.                   pts
    
59.           )
    
60.         )
    
61.       )
    
62.     )
    
63.   )
    
64.   (princ)
    
65. )

<br /> (defun c:tt (/ ss dis ps box ss v pb sss m n p0 pls pts _pi2 trilst)<br />   (if (and (setq dis (getdist "\nDistance of Axis: "))<br />            (setq ps (ssget "+.:S" '((0 . "*Polyline"))))<br />            (setq pl (ssname ps 0))<br />            (setq pls (xlrx-curve-getstretchpoints pl))<br />            (setq ss (ssget "x" '((0 . "insert") (2 . "99"))))<br />            (setq sss (XLRX-TriAngle ss ps nil t))<br />       )<br />     (progn<br />       (setq box           (list (apply 'mapcar (cons 'min pls))<br />                          (apply 'mapcar (cons 'max pls))<br />                    )<br />             v           (mapcar 'abs (apply 'mapcar (cons '- box)))<br />             pb           (car box)<br />             m           (fix (/ (car v) dis))<br />             n           (fix (/ (cadr v) dis))<br />             p0           pb<br />             trilst (mapcar 'xlrx-curve-getstretchpoints<br />                            (xlrx-pickset->list sss)<br />                    )<br />       )<br />       (repeat m<br />         (setq pts (cons (setq p0 (polar p0 0.0 dis)) pts))<br />       )<br />       (setq pts         (cons pb (reverse pts))<br />             _pi2 (/ pi 2)<br />       )<br />       (mapcar<br />         '(lambda (b / stri)<br />            (if (setq stri<br />                       (vl-member-if<br />                         '(lambda (c)<br />                            (apply 'xlrx-point-getTriIntersElev (cons b c))<br />                          )<br />                         trilst<br />                       )<br />                )<br />              (apply 'xlrx-point-getTriIntersElev (cons b (car stri)));_能计算高程的点<br />              (entmake (list '(0 . "point") (cons 10 b)));_三角网外部的点<br />            )<br />          )<br />         (apply<br />           'append<br />           (mapcar '(lambda (x / p ptl)<br />                      (setq p x)<br />                      (repeat n<br />                        (setq ptl (cons (setq p (polar p _pi2 dis)) ptl))<br />                      )<br />                      (vl-remove-if<br />                        '(lambda        (a)<br />                           (not (XLRX-Point-IsInPoly1 a pls))<br />                         )<br />                        (cons x (reverse ptl))<br />                      )<br />                    )<br />                   pts<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

ivde

置顶帖子
XLRX_API for CAD2004~2014函数库 2015.08.27更新
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=113010&mobile=yes

ivde

(apply 'xlrx-point-getTriIntersElev (cons b (car stri)));_能计算高程的点

这部分点就可以输出了

ivde

已经算出来了

liqiuyulove

好东西啊   真神奇