提取三维多段线桩号an
您好，我正在尝试将桩号和高程从三维多段线提取到txt文件重要提示：对于车站，我只需要水平距离，不需要坡度距离
（我需要这个文件用于横截面）
这是一个旧代码，我试图更改它，但失败了！！例如，我附加了两个导出文件
(defun c:sz (/ ent fh fn hnd itm num obj pnt sset v vexx)
;; helper to get 3dpoly coordinates
(defun 3dpoly-verts(en / elistlst vex)
(if (member "AcDb3dPolyline"
(mapcar 'cdr (entget en)))
(progn
(setq vex (entnext en))
(setq elist (entget vex))
(while (= (cdr (assoc 0 elist)) "VERTEX")
(setq lst (cons (trans (cdr (assoc 10 elist)) 1 0) lst))
(setq vex (entnext vex))
(setq elist (entget vex))
)
)
)
(reverse lst)
)
;;________________________________________________;;
(setq sset (ssget '((-4 . "<OR")(0 . "POINT")
(0 . "POLYLINE")(-4 . "OR>"))))
(if sset
(progn
(setq itm 0 num (sslength sset))
(setq fn (getfiled "Αποθήκευση αρχείου station,Z" "" "txt" 1))
(if (/= fn nil)
(progn
(setq fh (open fn "w"))
(while (< itm num)
(setq hnd (ssname sset itm))
(setq ent (entget hnd))
(setq obj (cdr (assoc 0 ent)))
(cond
((eq obj "POINT")
(setq pnt (cdr (assoc 10 ent)))
(setq pnt (trans pnt 0 1));;**CAB
(write-line (strcat (rtos (distance pnt pnt) 2 3) "," ; i don't know how to give the distanse
(rtos (caddr pnt) 2 3)) fh)
)
((= obj "POLYLINE")
(setq v hnd)
(setq vexx (3dpoly-verts v ))
(foreach pnt vexx
(write-line (strcat (rtos (distance pnt pnt) 2 3) ","; i don't know how to give the distanse
(rtos (caddr pnt) 2 3)) fh)
)
)
(t nil)
)
(setq itm (1+ itm))
)
(close fh)
)
)
)
)
(princ)
)
(princ)
测试1（开放多边形）。txt文件
test1（闭合多边形）。txt文件
测验图纸 如果你没有任何曲线，这将起作用，但你必须做距离点的xy位，记住毕达哥拉斯thereom。
; pline co-ords example
(defun getcoords (ent)
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property
(vlax-ename->vla-object ent)
"Coordinates"
)
)
)
)
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(setq co-ords (getcoords (car (entsel "\nplease pick pline"))))
(co-ords2xy) ; list of 2d or 3d points making pline
; list xy is 2d or 3d pts
嗨，prodromosm，
只是一个想法，
我认为是时候开始尝试编写自己的代码了。
这个演示只是一种不同的方法。。。
试着理解代码，它是以一种简单的方式编写的，我认为它将很容易理解，如果不是，只要问。。。
(defun c:demo (/ e fn fo lst par parpt poly pos pre pt s)
(prompt "\nSelect a 3DPolyline to extract Stations and Elevations to txt file: ")
(if
(and (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
(setq fn (getfiled "Enter the output filename:" (getvar 'DWGPREFIX) "txt" 1))
(setq pre (strcase (getstring "\nEnter station prefix:")))
);; and
(progn
(setq poly (vlax-ename->vla-object (ssname s 0))
e (fix (vlax-curve-getEndParam poly))
pos0
par0
lstnil
);; setq
(while (/= par (1+ e))
(setq pt(vlax-curve-getPointAtParam poly par)
pos (1+ pos)
);; setq
(if (not parpt)
(setq lst (cons (strcat pre (itoa pos) "," "0.000," (rtos (caddr pt) 2 3)) lst)
parpt pt
);; setq
(setq lst (cons (strcat pre (itoa pos) "," (rtos (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt))) 2 3) "," (rtos (caddr pt) 2 3)) lst)
parpt pt
);; setq
);; if
(setq par (1+ par))
);; while
(if lst
(progn
(setq lst (reverse lst)
fo(open fn "w")
);; setq
(foreach l lst
(write-line l fo)
);; foreach
(close fo)
);; progn
);; if
);; progn
);; if
(princ)
);; demo
HTH公司
亨里克 谢谢你，hmsilva。我有个问题。如果我想从多段线导出更多数据，我该怎么做？例如，在中间距离列之后，我想添加一个从起始列到elevetion的距离
不客气，prodromosm！
尝试
(defun c:demo (/ acdist e fn fo lst par parpt pdist poly pos pre pt s)
(prompt "\nSelect a 3DPolyline to extract Stations and Elevations to txt file: ")
(if
(and (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
(setq fn (getfiled "Enter the output filename:" (getvar 'DWGPREFIX) "txt" 1))
(setq pre (strcase (getstring "\nEnter station prefix:")))
);; and
(progn
(setq poly (vlax-ename->vla-object (ssname s 0))
e (fix (vlax-curve-getEndParam poly))
pos0
par0
acdist 0.0;; <--Start accumulated distance
lstnil
);; setq
(while (/= par (1+ e))
(setq pt(vlax-curve-getPointAtParam poly par)
pos (1+ pos)
);; setq
(if (not parpt)
(setq lst (cons (strcat pre (itoa pos) "," "0.000,0.000," (rtos (caddr pt) 2 3)) lst)
parpt pt
);; setq
(setq lst (cons (strcat pre (itoa pos) ","
;; store the partial distance at the pdist variable
(rtos (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))) 2 3)
;; adding acdist and pdist, and store the accumulated distance at acdist variable
"," (rtos (setq acdist (+ acdist pdist)) 2 3)
"," (rtos (caddr pt) 2 3)) lst)
parpt pt
);; setq
);; if
(setq par (1+ par))
);; while
(if lst
(progn
(setq lst (reverse lst)
fo(open fn "w")
);; setq
(foreach l lst
(write-line l fo)
);; foreach
(close fo)
);; progn
);; if
);; progn
);; if
(princ)
);; demo
嗨，席尔瓦，你能修改一下帖子#5中的代码吗
在帖子#5中，我们得到了这个结果
非常感谢。
你能把它改成只出口吗
嗨prodromosm，
正如我早些时候所说的
“我认为是时候开始尝试编写自己的代码了。”
所以，我确实给你想要修改的代码添加了一些注释，这是一项简单的任务，试着自己修改代码，如果你有任何问题，只要问。。。
; pline example listing various properties like pts and lengths
; By Alan H 2014
(defun getcoords (ent)
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property
(vlax-ename->vla-object ent)
"Coordinates"
)
)
)
)
(defun getlength (ent)
(vlax-get-property (vlax-ename->vla-object ent) "Length")
)
(defun co-ords2xy ()
; convert now to xyz
(setq xyprin "\n") ; new line
(if (= xyz 2)
(progn
(setq I 0)
(repeat (/ len 2)
(setq x (nth i co-ords))
(setq y (nth (+ I 1) co-ords))
(setq xy (listx y))
(setq xyprin (strcat xyprin "\n" (rtos x 2 2) "," (rtos y 2 2 )))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
) ; repeat
) ; progn
) ; if
(if (= xyz 3)
(progn
(setq xyprin "\n") ; new line
(setq I 0)
(repeat (/ len 3)
(setq x (nth i co-ords))
(setq y (nth (+ I 1) co-ords))
(setq z (nth (+ I 2) co-ords))
(setq xy (list x y z))
(setq xyprin (strcat xyprin "\n" (rtos x 2 2) "," (rtos y 2 2 ) "," (rtos z 2 2 )))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 3))
) ; repeat
) ; progn
) ; if
) ; defun
; program starts here
(setq ent (car (entsel "\nPlease pick pline")))
(setq co-ords (getcoords ent ))
(setq len (length co-ords))
; check for odd even list 2d v's 3d
(setq oddeven (- (fix (/ len 2.0))(/ len 2.0)))
(if (= oddeven 0.5)
(setq xyz 3) ; 3d pline
(setq xyz 2) ; 2d pline
)
(setq numvert (/ len xyz))
(princ (strcat "\nNumber of vertices " (rtos numvert 2 0)))
(co-ords2xy)
(princ xyprin) ; prints out points co-ords
(setq pllen (getlength))
(princ (strcat "\nActual length of pline " (rtos pllen 2 2)))
; to be done (princ segment lengths 2d)
; tobe done (princ segment lengths 3d) if different
; to be done (princ angle of segments)
; to be done (princ delta angle of segments
(princ)
HTH公司
亨里克 嗨，hmsilva你能帮我解决这个错误吗？我试着把代码改成只导出
但是现在我不能导出任何文件！！！
(if (not parpt);; tests for parpt existence, if not, initializes the lst list with the first string
(setq lst (cons;; to add elements to the lst list
(strcat;; to concatenate multiple strings in one
pre;; first sting element, the prefix i.e D
(itoa pos);; the prefix index
"," "0.000,0.000,";; second and third string elements, the partial and accumulated distances
(rtos (caddr pt) 2 3);; the fourth string element, the Z value
);; strcat
lst);; cons
parpt pt;; sets parpt with the pt value
);; setq
;; if the lst list is already initialized, just continues to add strings to the lst list
(setq lst (cons;; to add elements to the lst list
(strcat;; to concatenate multiple strings in one
pre;; first sting element, the prefix i.e D
(itoa pos);; the prefix index
",";; the first comma separator
;; store the partial distance at the pdist variable
(rtos (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))) 2 3)
",";; the second comma separator
;; the third string element adding acdist and pdist,
;; and store the accumulated distance at acdist variable
(rtos (setq acdist (+ acdist pdist)) 2 3)
",";; the third comma separator
(rtos (caddr pt) 2 3);; the fourth string element, the Z value
);; strcat
lst);; cons
parpt pt;; sets parpt with the pt value
);; setq
);; if
谢谢
嗨，prodromosm，
快速修复。。。
(defun c:demo (/ e fn fo lst par parpt poly pos pre pt s)
(prompt "\nSelect a 3DPolyline to extract Stations and Elevations to txt file: ")
(if
(and (setq s (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "&") (70 . )))
(setq fn (getfiled "Enter the output filename:" (getvar 'DWGPREFIX) "txt" 1))
);; and
(progn
(setq poly (vlax-ename->vla-object (ssname s 0))
e (fix (vlax-curve-getEndParam poly))
pos0
par0
lstnil
);; setq
(while (/= par (1+ e))
(if (not parpt)
(setq lst (cons (strcat"," "0.000," (rtos (caddr pt) 2 3)) lst)
parpt pt
);; setq
(setq lst (cons (strcat "," (rtos (setq acdist (+ acdist pdist)) 2 3) "," (rtos (caddr pt) 2 3)) lst)
parpt pt
);; setq
);; if
(setq par (1+ par))
);; while
(if lst
(progn
(setq lst (reverse lst)
fo(open fn "w")
);; setq
(foreach l lst
(write-line l fo)
);; foreach
(close fo)
);; progn
);; if
);; progn
);; if
(princ)
);; demo
未经测试，我现在没有AutoCAD。。。
亨里克 无论有没有AutoCAD，你都是我最棒的朋友！！！
谢谢
页:
[1]
2