我使用南方cass的，现想弄个lisp小程序，画一条多义线让它经过图面上的需要提取的...

劳改

    我使用南方cass的，现想弄个lisp小程序，画一条多义线让它经过图面上的需要提取的高程点；即按多义线前进的方向按其先后顺序生成dat文件。哪位大虾帮弄下啊，或给个思路也好啊。

19622928

你是想提取中线上的高程值，还是坐标一起

st788796

不画线直接选点不可以？

77077

应该可以参考断面提取程序

劳改

我只是想提取多义线经过的高程值及坐标。只是在编的时候不知如何搜索如何判断？

劳改

19622928 发表于 2014-2-19 14:40
你是想提取中线上的高程值，还是坐标一起

一起，且必须按顺序生成dat 数据文件。

st788796

劳改 发表于 2014-2-25 08:52
一起，且必须按顺序生成dat 数据文件。

描点也是按顺序, 线画不画的都可以提出 Dat

1. (defun c:tt (/ s e p ptl el)
   
2.   (while (and (setq s (ssget ":S" '((0 . "Insert"))))
   
3.               (setq e (ssname s 0))
   
4.               (setq p (cdr (assoc 10 (entget e))))
   
5.               (setq el (cons e el))
   
6.               (setq ptl (cons p ptl))
   
7.               (progn
   
8.                 (if (> (length ptl) 1)
   
9.                   (grdraw p (cadr ptl) 1 1)
   
10.                 )
    
11.                 t
    
12.               )
    
13.          )
    
14.   )
    
15.   (princ)
    
16. )

(defun c:tt (/ s e p ptl el)<br />   (while (and (setq s (ssget ":S" '((0 . "Insert"))))<br />               (setq e (ssname s 0))<br />               (setq p (cdr (assoc 10 (entget e))))<br />               (setq el (cons e el))<br />               (setq ptl (cons p ptl))<br />               (progn<br />                 (if (> (length ptl) 1)<br />                   (grdraw p (cadr ptl) 1 1)<br />                 )<br />                 t<br />               )<br />          )<br />   )<br />   (princ)<br /> )

19622928

2. ;本程序提取中线上各结点坐标及高程
   
3. (defun c:tt(/ l qz zh zb gcb n file x y h gcblws)
   
4.   (setq file (getfiled "中线坐标" "D:\" "txt" 1))
   
5.   (setq f1 (open file "w"))
   
6.   (setq l (car (entsel "\n请选择中线:")))
   
7.   (setq qz (strcase(getstring "\n请输入中桩前辍:<A>")))
   
8.   (if (= "" qz) (setq qz "A"))
   
9.   (setq zh (getint "\n请输入起始桩号:<1>"))
   
10.   (if (not zh)(setq zh 1))
    
11.   (setq x (getint "\n请输入X保留位数:<3>"))
    
12.   (setq y (getint "\n请输入Y保留位数:<3>"))
    
13.   (setq h (getint "\n请输入H保留位数:<2>"))
    
14.   (if (not x) (setq x 3))(if (not y) (setq y 3))(if h (setq gcblws h)(setq gcblws 2))
    
15.   (setq zb (xu_zb l))
    
16.   (setq gcb (plgcz l))
    
17.   (setq n 0)
    
18.   (repeat (length gcb)
    
19.     (princ (strcat "\n" qz (itoa zh)","  (rtos (cdr (nth n zb)) 2 x) "," (rtos (car (nth n zb)) 2 y)","(nth n gcb)))
    
20.     (write-line (strcat qz (itoa zh)","  (rtos (cdr (nth n zb)) 2 x) "," (rtos (car (nth n zb)) 2 y)","(nth n gcb)) f1)
    
21.     (setq n (1+ n) zh (1+ zh))
    
22.     )
    
23.   (close f1)
    
24.   (alert "\n中线坐标已生成！\n")
    
25.   (princ)
    
26.   )

;本程序提取中线上各结点坐标及高程<br /> (defun c:tt(/ l qz zh zb gcb n file x y h gcblws)<br />   (setq file (getfiled "中线坐标" "D:\" "txt" 1))<br />   (setq f1 (open file "w"))<br />   (setq l (car (entsel "\n请选择中线:")))<br />   (setq qz (strcase(getstring "\n请输入中桩前辍:<A>")))<br />   (if (= "" qz) (setq qz "A"))<br />   (setq zh (getint "\n请输入起始桩号:<1>"))<br />   (if (not zh)(setq zh 1))<br />   (setq x (getint "\n请输入X保留位数:<3>"))<br />   (setq y (getint "\n请输入Y保留位数:<3>"))<br />   (setq h (getint "\n请输入H保留位数:<2>"))<br />   (if (not x) (setq x 3))(if (not y) (setq y 3))(if h (setq gcblws h)(setq gcblws 2))<br />   (setq zb (xu_zb l))<br />   (setq gcb (plgcz l))<br />   (setq n 0)<br />   (repeat (length gcb)<br />     (princ (strcat "\n" qz (itoa zh)","  (rtos (cdr (nth n zb)) 2 x) "," (rtos (car (nth n zb)) 2 y)","(nth n gcb)))<br />     (write-line (strcat qz (itoa zh)","  (rtos (cdr (nth n zb)) 2 x) "," (rtos (car (nth n zb)) 2 y)","(nth n gcb)) f1)<br />     (setq n (1+ n) zh (1+ zh))<br />     )<br />   (close f1)<br />   (alert "\n中线坐标已生成！\n")<br />   (princ)<br />   )

劳改

19622928 发表于 2014-2-25 09:57

多谢大侠的代码，但我用了下没有读取高程啊！

w379106181

谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享