提取三维多段线桩号an

hmsilva · 发表于 2022-7-5 23:03:01

不客气，prodromosm！

看看你的代码和我的代码之间的差异，试着找出为什么你的代码没有按预期工作。

干杯
亨里克

prodromosm · 发表于 2022-7-5 23:05:32

您好，可以使用中心线更新以导出数据吗。

看附件，你就会明白
测试1.dwg
导出数据。txt文件

hmsilva · 发表于 2022-7-5 23:11:47

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))
 ; no prefix
 ;|(setq pre (strcase (getstring "\nEnter station prefix:")))|;
   );; and
    (progn
      (setq poly (vlax-ename->vla-object (ssname s 0))
     e          (fix (vlax-curve-getEndParam poly))
     pos  0
     par  0
     acdist 0.0
     lst  nil
      );; 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
   ;; the pdist variable is needed to the accumulated the distance
   (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))
         lst (cons (strcat
            ;|pre (itoa pos) ","
            (rtos (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))) 2 3) ","|;
            (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)
   (startapp "notepad" fn);; added to open the new txt file
 );; progn
      );; if
    );; progn
 );; if
 (princ)
);; demo

尊敬的d.i.a.Marko Ribar。

prodromosm · 发表于 2022-7-5 23:15:11

好人！

hmsilva · 发表于 2022-7-5 23:17:48

谢谢marko_ribar

prodromosm · 发表于 2022-7-5 23:20:20

marko_ribar · 发表于 2022-7-5 23:25:11

prodromosm, try this revision...

copy

(defun c:demo (/ acdcp acdist cp e fn fo lst osm par parpt pdist poly              pos pre pt s) (vl-load-com) (setq osm (getvar 'osmode)) (setvar 'osmode 1) (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                 )        )                                       ; no prefix        ;|(setq pre (strcase (getstring "\nEnter station prefix:")))|;        (setq cp (getpoint "\nClick or specify center point : "))   );; and    (progn      (setq poly   (vlax-ename->vla-object (ssname s 0))            e      (fix (vlax-curve-getEndParam poly))            pos    0            par    0            acdist 0.0            lst    nil            cp     (vlax-curve-getClosestPointToProjection                     poly                     cp                     '(0.0 0.0 1.0)                   )      )      ;; 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          ;; the pdist variable is needed to the accumulated the distance          (setq pdist (distance (list (car pt) (cadr pt))                                (list (car parpt) (cadr parpt))                      )                lst   (cons (strcat                             ;|pre (itoa pos) ","           (rtos (setq pdist (distance (list (car pt) (cadr pt)) (list (car parpt) (cadr parpt)))) 2 3) ","|;                              (rtos (setq acdist (+ acdist pdist)) 2 3)                              ","                              (rtos (caddr pt) 2 3)                            )                            lst                      )                parpt pt          )          ;; setq        )        ;; if        (if (equal pt cp 1e-          (setq acdcp (- acdist))        )        (setq par (1+ par))      )      ;; while      (if lst        (progn          (setq lst (mapcar '(lambda (x)                               (strcat (rtos (+ (atof x) acdcp) 2 3)                                       (substr x (1+ (vl-string-search "," x)))                               )                             )                            (reverse lst)                    )                fo  (open fn "w")          )          ;; setq          (foreach l lst            (write-line l fo)          )          ;; foreach          (close fo)          (startapp "notepad" fn)          ;; added to open the new txt file        )        ;; progn      )      ;; if    )    ;; progn ) ;; if (setvar 'osmode osm) (princ));; demo

Regards, Marko Ribar, d.i.a.