本帖最后由 作者 于 2008-4-6 11:43:48 编辑
附件是一个可读取任意线的顶点坐标,并已文本输出的程序,希望大家帮忙改改,让它一行一根线数据而不是一行一个点的数据,我所提取的多义线只有2~4点.写出数据要保证4个点.数据形式如下:
(线)1,x1,y1z1,x2,y2,z2,x3,y3,z3,x4,y4,z4----(点与点间以逗号隔开)
(线)2,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4
(线)3,x1,y1,z1,x2,y2,z2,x3,y3,z3,9999,9999,9999--(点数不够以9999补满) ;;;;;;;;;;;;;;根据等高线标高取出数据
(DEFUN C:outh
(/ SST H fi N I J K p NAME DXF TYPE_LINE XY_COUNT F x y PT1 D N1)
(setq fi '((-4 . "<OR") ; Filter for ssget.
(0 . "POLYLINE")
(0 . "LWPOLYLINE")
(0 . "SHAPE")
(0 . "INSERT")
(-4 . "OR>")
)
)
(setq F (getfiled "写出文件" "" "txt" 1))
(SETQ F (OPEN F "w"))
(PROMPT " \n选取等高线:")
(SETQ SST (SSGET fi))
(SETQ N (SSLENGTH SST))
(SETQ J 0)
(setq k 0)
(setq p (getint " \n指定起始点号<1>:"))
(IF (= NIL P)
(setq p 1)
)
(REPEAT N
(SETQ NAME (SSNAME SST J))
(SETQ J (1+ J))
(SETQ DXF (ENTGET NAME))
(SETQ TYPE_LINE (CDR (ASSOC 0 DXF)))
(COND (
(= TYPE_LINE "POLYLINE")
(SETQ XY_COUNT (POLYLINE DXF NAME))
(setq i (length xy_count))
(setq k 0)
(repeat i
(setq y (nth k xy_count))
(setq h (nth 2 y))
(setq x (nth 1 y))
(setq y (nth 0 y))
(setq y (strcat (itoa P)
","
(rtos Y 2 3)
","
(rtos X 2 3)
","
(rtos h 2 3)
)
)
(write-line y f)
(setq p (1+ p))
(setq k (1+ k))
(setq D D)
(setq N1 N1)
)
)
((= TYPE_LINE "LWPOLYLINE")
(SETQ H (CDR (ASSOC 38 DXF)))
(SETQ XY_COUNT (LWPOLYLINE DXF))
(setq i (length xy_count))
(setq k 0)
(repeat i
(setq y (nth k xy_count))
(setq x (nth 1 y))
(setq y (nth 0 y))
(setq y (strcat (itoa P)
","
(rtos X 2 3)
","
(rtos Y 2 3)
","
(rtos h 2 3)
)
)
(write-line y f)
(setq p (1+ p))
(setq k (1+ k))
(setq D D)
(setq N1 N1)
)
)
((OR (= TYPE_LINE "SHAPE") (= TYPE_LINE "INSERT"))
(SETQ PT1 (CDR (ASSOC 10 DXF)))
(SETQ X (NTH 1 PT1))
(SETQ Y (NTH 0 PT1))
(SETQ H (NTH 2 PT1))
(setq y (strcat (itoa P)
","
(rtos Y 2 3)
","
(rtos X 2 3)
","
(rtos h 2 3)
)
)
(write-line y f)
(setq p (1+ p))
(setq D D)
(setq N1 N1)
)
)
)
(close f)
)
;;;;;;;;;;;;;;;;;;;
(defun POLYLINE (DXF E1 / XY E2 count_xy pd)
(setq count_xy nil)
(SETQ DXF (MEMBER (ASSOC 330 DXF) DXF))
(SETQ E2 (ENTNEXT E1))
(SETQ DXF (ENTGET E2)) (setq e1 (cdr (assoc 0 dxf)))
(while (= e1 "VERTEX")
(setq e1 (cdr (assoc 10 dxf)))
(setq pd (cdr (assoc 70 dxf)))
(if (/= pd 16)
(setq count_xy (cons e1 count_xy))
)
(setq e1 e2)
(SETQ E2 (ENTNEXT E1))
(SETQ DXF (ENTGET E2))
(setq e1 (cdr (assoc 0 dxf)))
)
(setq COUNT_XY (reverse count_xy))
)
;;;;;;;;;;;;;;;;;;;;;;;
(defun LWPOLYLINE (DXF / XY COUNT_XY)
(SETQ XY (ASSOC 10 DXF))
(SETQ COUNT_XY ())
(WHILE XY
(SETQ DXF (MEMBER XY DXF))
(SETQ XY (CDR (ASSOC 10 DXF)))
(SETQ DXF (CDR DXF))
(SETQ COUNT_XY (CONS XY COUNT_XY))
(SETQ XY (ASSOC 10 DXF))
)
(setq COUNT_XY (reverse COUNT_XY))
)
;;;;;;;;;;;;;
(defun ap-3d->2d (p1 / a b c)
(setq a (nth 0 p1))
(setq b (nth 1 p1))
(setq p1 (list a b))
) ;;;;;;;;;;;;;;;;;
(DEFUN PDINDX (SST P1 / DIST INDX B JD N
J K DIST_SST MAX_P1 MAX_P2 NAME INDX
JD_NEAR MESG
)
(SETQ J 0)
(SETQ P1 (AP-3D->2D P1))
(SETQ N (SSLENGTH SST))
(REPEAT N
(SETQ B (SSNAMEX SST J))
(SETQ JD (AP-3D->2D (NTH 0 (CDR (NTH 3 (NTH 0 B)))))) (SETQ NAME (NTH 1 (NTH 0 B)))
(SETQ DIST (distance p1 jd))
(SETQ DIST_SST (CONS DIST DIST_SST))
(SETQ NAME_SST (CONS NAME NAME_SST))
(SETQ J (1+ J))
)
(SETQ J 0)
(WHILE (/= J (- N 1))
(SETQ K 0)
(WHILE (/= K (- N 1))
(SETQ MAX_P1 (NTH K DIST_SST))
(SETQ MAX_P2 (NTH (+ K 1) DIST_SST))
(IF (> MAX_P1 MAX_P2)
(PROGN
(SETQ B (CDR (MEMBER MAX_P2 DIST_SST)))
(SETQ B (CONS MAX_P1 B))
(SETQ B (CONS MAX_P2 B))
(SETQ JD (- K 1))
(REPEAT K
(SETQ MAX_P1 (NTH JD DIST_SST))
(SETQ B (CONS MAX_P1 B))
(SETQ JD (- JD 1))
)
(SETQ DIST_SST B)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(SETQ MAX_P1 (NTH K NAME_SST))
(SETQ MAX_P2 (NTH (+ K 1) NAME_SST)) (SETQ B (CDR (MEMBER MAX_P2 NAME_SST)))
(SETQ B (CONS MAX_P1 B))
(SETQ B (CONS MAX_P2 B))
(SETQ JD (- K 1))
(REPEAT K
(SETQ MAX_P1 (NTH JD NAME_SST))
(SETQ B (CONS MAX_P1 B))
(SETQ JD (- JD 1))
)
(SETQ NAME_SST B)
)
)
(SETQ K (1+ K))
)
(SETQ J (1+ J))
)
(SETQ NAME_SST NAME_SST)
)
;
| 
[复制链接]
发表于 2008-4-6 11:33
置顶卡
变色卡
显身卡
发表于 2008-4-6 16:00
楼主