[求助]：怎样把提取出的xyz重新定义为一个坐标点

SGP007

刚学，请指教，怎样把dx dy dz 重新定义为一个新坐标
(setq  p1 (getpoint  "\n基点")
        d (getpoint  "\n选点")
       dx (car d)
       dy (cadr d)
       dz (getreal "\n输入Z")
我想做这样一个东东，就是在画三维多段线过程中，xy值由鼠标拾取，而z值由人工输入，这样的多段线怎样能连续画下去呢？
请高手指点，不胜感激。

XDSoft

最初由 SGP007 发布
[B]刚学，请指教，怎样把dx dy dz 重新定义为一个新坐标
(setq  p1 (getpoint  "\n基点")
        d (getpoint  "\n选点")
       dx (car d)
       dy (cadr d)
       dz (getreal "\n输入Z")
我想做这样一个?.. [/B]

把取点和画多段线的命令放到一个循环里面了，回车（不取点时候）退出。

SGP007

刚学，很多不懂，还得请教一下：怎样把dx dy dz 重新定义为一个新坐标呢？
这个循环怎么做呢？

雄啸

(defun c:tt ()
  (command "_.3dpoly")
  (while (/= 0 (getvar "cmdactive"))
    (if        (and (setq d (getpoint "\n point for xy:"))
             (setq dz (getdist "\n Z value:"))
        )
      (command "non" (list (car d) (cadr d) dz))
      (command "")
    )
  )
)

SGP007

高手果然厉害，佩服佩服，非常感谢。
那么提取三位多段线的坐标xyz到文本怎样实现呢？

Underway

文本内的呈现格式如何
可有样例

SGP007

比如100，200，20

Underway

2. 
   
3. (defun coord (ee / dat rp ptss)
   
4.   (setq dat (entget ee)
   
5.          rp 1
   
6.   )
   
7.   (while rp
   
8.     (setq dat (entget (entnext (cdr (car dat)))))
   
9.     (if (/= (cdr (assoc 0 dat)) "SEQEND")
   
10.       (setq ptss (cons (cdr (assoc 10 dat)) ptss))
    
11.       (setq rp nil)
    
12.     )                                   ; if
    
13.   )                                     ; while
    
14.   (reverse ptss)
    
15. )
    
16. ;;
    
17. 
    
18. 
    
19. (defun WrtPt (ee fp)
    
20.    (mapcar
    
21.      (function
    
22.        (lambda (pt)
    
23.          (Write-line
    
24.            (strcat
    
25.              (rtos (car pt))
    
26.              ",  "
    
27.              (rtos (cadr pt))
    
28.              ",  "
    
29.              (rtos (caddr pt))
    
30.            )
    
31.            fp
    
32.      ) ) )
    
33.      (coord  ee)
    
34.    )
    
35. )
    
36. 
    
37. (defun c:try ()
    
38.   (if (and
    
39.         (setq ss (ssget ":S:E" '((0 . "POLYLINE"))))
    
40.         (setq fp (open "C:/xyz.txt" "w"))
    
41.       )
    
42.     (and
    
43.       (wrtPt (ssname ss 0) fp)
    
44.       (close fp)
    
45.     )
    
46.   )
    
47.   (princ)
    
48. )
    

<br /> (defun coord (ee / dat rp ptss)<br />   (setq dat (entget ee)<br />          rp 1<br />   )<br />   (while rp<br />     (setq dat (entget (entnext (cdr (car dat)))))<br />     (if (/= (cdr (assoc 0 dat)) "SEQEND")<br />       (setq ptss (cons (cdr (assoc 10 dat)) ptss))<br />       (setq rp nil)<br />     )                                   ; if<br />   )                                     ; while<br />   (reverse ptss)<br /> )<br /> ;;<br /> <br /> <br /> (defun WrtPt (ee fp)<br />    (mapcar<br />      (function<br />        (lambda (pt)<br />          (Write-line<br />            (strcat<br />              (rtos (car pt))<br />              ",  "<br />              (rtos (cadr pt))<br />              ",  "<br />              (rtos (caddr pt))<br />            )<br />            fp<br />      ) ) )<br />      (coord  ee)<br />    )<br /> )<br /> <br /> (defun c:try ()<br />   (if (and<br />         (setq ss (ssget ":S:E" '((0 . "POLYLINE"))))<br />         (setq fp (open "C:/xyz.txt" "w"))<br />       )<br />     (and<br />       (wrtPt (ssname ss 0) fp)<br />       (close fp)<br />     )<br />   )<br />   (princ)<br /> )<br />

SGP007

非常感谢，这个地方这样就对了(rtos (car pt))
             ",  "
             (rtos (cadr pt))
             ",  "
             (rtos (caddr pt))

Underway

Sorry!  Copy后未即修改
又奈何不让更正 .....

SGP007

首先，非常感谢各位高手指点！
我想加入这样一个功能，确定起点后：每点一个点，就输出这个点到起点的距离 和 输入的Z值。
命令行的提示我做出了，但是怎样输出的文本呢？或者全部一次输出也行。本来我是输出坐标到excel里面处理，但是这样有点麻烦。所以还得请教高手

(vl-load-com)
(defun c:k ()
(setq qd (getpoint "\n 请拾取起点:")
      qdx (car qd)
      qdy (cadr qd)
      qdlc (getreal "\n 请输入起点里程")
)
(command "_.3dpoly")
(while (/= 0 (getvar "cmdactive"))
(if (and (setq d (getpoint "\n 请拾取点:"))
(setq dz (getdist "\n 请输入标高:"))
)
(command "non" (list (car d) (cadr d) dz))
(command "")
)
(setq     xcz (- (car d) qdx)
          ycz (- (cadr d) qdy)
           xx (expt xcz 2)
           yy (expt ycz 2)
           ooo (+ xx yy)
           cd (sqrt ooo)
           lc (+ qdlc cd)
)
(princ "\n 当前点里程为：")
(princ lc)
(princ "\n 当前点标高为：")
(princ dz)
)

)

Underway

...本来我是输出坐标到excel里面处理.. [/B]

就上传您处理完成的作参考如何
主要是得清楚其中的格式段落

SGP007

格式如下：里程就是变量LC，高程就是变量DZ

里程        高程
155000         310
155005         315
155090         320

Underway

2. 
   
3. (defun c:k ()
   
4.   (setq qd   (getpoint "\n 請拾取起點:")
   
5.         qdx  (car qd)
   
6.         qdy  (cadr qd)
   
7.         qdlc (getreal "\n 請輸入起點里程")
   
8.           fp (open "C:/里程.txt" "w")
   
9.   )
   
10.   
    
11.   (command "_.3dpoly")
    
12.   (while (/= 0 (getvar "cmdactive"))
    
13.     (if (and (setq d (getpoint "\n 請拾取點:"))
    
14.              (setq dz (getdist "\n 請輸入標高:"))
    
15.         )
    
16.       (progn   
    
17.         (command "non" (list (car d) (cadr d) dz))
    
18.         (setq xcz (- (car d) qdx)
    
19.               ycz (- (cadr d) qdy)
    
20.               xx  (expt xcz 2)
    
21.               yy  (expt ycz 2)
    
22.               ooo (+ xx yy)
    
23.               cd  (sqrt ooo)
    
24.               lc  (+ qdlc cd)
    
25.         )
    
26.         (princ "\n 當前點里程為：")
    
27.         (princ lc)
    
28.         (princ lc fp)
    
29.         (princ "\n 當前點標高為：")
    
30.         (princ dz)
    
31.         (princ "    " fp)  ; or (princ "         " fp)  .....
    
32.         (princ dz fp)
    
33.         (princ (chr 10) fp)
    
34.       )  
    
35.       (command "")
    
36.     )
    
37.   )
    
38.   (close fp)
    
39. )
    

<br /> (defun c:k ()<br />   (setq qd   (getpoint "\n 請拾取起點:")<br />         qdx  (car qd)<br />         qdy  (cadr qd)<br />         qdlc (getreal "\n 請輸入起點里程")<br />           fp (open "C:/里程.txt" "w")<br />   )<br />   <br />   (command "_.3dpoly")<br />   (while (/= 0 (getvar "cmdactive"))<br />     (if (and (setq d (getpoint "\n 請拾取點:"))<br />              (setq dz (getdist "\n 請輸入標高:"))<br />         )<br />       (progn   <br />         (command "non" (list (car d) (cadr d) dz))<br />         (setq xcz (- (car d) qdx)<br />               ycz (- (cadr d) qdy)<br />               xx  (expt xcz 2)<br />               yy  (expt ycz 2)<br />               ooo (+ xx yy)<br />               cd  (sqrt ooo)<br />               lc  (+ qdlc cd)<br />         )<br />         (princ "\n 當前點里程為：")<br />         (princ lc)<br />         (princ lc fp)<br />         (princ "\n 當前點標高為：")<br />         (princ dz)<br />         (princ "    " fp)  ; or (princ "         " fp)  .....<br />         (princ dz fp)<br />         (princ (chr 10) fp)<br />       )  <br />       (command "")<br />     )<br />   )<br />   (close fp) <br /> )<br />

zml84

[php]
命令: tt2 功能：批量输出逐桩坐标及方位角。
请点取道路设计线: 路线全长: 693.117
请输入起始桩号<10>:
***起点桩号: 10    终点桩号: 703.117
请输入桩号间隔<20>: 50

(50.0 (669.297 556.155 0.0) 1.38466)
(100.0 (679.405 605.119 0.0) 1.34284)
(150.0 (692.887 653.243 0.0) 1.23588)
(200.0 (715.208 697.74 0.0) 0.903583)
(250.0 (758.634 716.496 0.0) -0.166722)
(300.0 (804.608 697.412 0.0) -0.505045)
(350.0 (848.201 672.929 0.0) -0.486229)
(400.0 (894.354 654.021 0.0) -0.240554)
(450.0 (943.758 654.901 0.0) 0.278383)
(500.0 (987.818 677.924 0.0) 0.650514)
(550.0 (1023.74 712.564 0.0) 0.865928)
(600.0 (1053.19 752.92 0.0) 1.00703)
(650.0 (1077.44 796.616 0.0) 1.11905)
(700.0 (1096.89 842.658 0.0) 1.2091)
是否标注中桩位置？[是(Y)/否(N)] <N>: y


命令:
命令: tt2 功能：批量输出逐桩坐标及方位角。
请点取道路设计线: 路线全长: 666.741
请输入起始桩号<30>:
***起点桩号: 30    终点桩号: 696.741
请输入桩号间隔<20>: 100

(100.0 (771.599 555.434 0.0) -0.439844)
(200.0 (865.255 521.107 0.0) -0.221779)
(300.0 (964.573 512.394 0.0) 0.046768)
(400.0 (1062.64 530.345 0.0) 0.315314)
(500.0 (1152.49 573.586 0.0) 0.560087)
(600.0 (1237.21 626.712 0.0) 0.560087)
是否标注中桩位置？[是(Y)/否(N)] <N>: y
[/php]