需要帮助创建多段线e

tieptouch · 发表于 2022-7-5 23:19:13

大家好，
对不起，我的英语太差了
我在图纸中有一条道路的中心线。我想从文件中在中心线的左侧和右侧创建两条多段线。txt文件

文件结构：
第1列：中心线的桩号
第2列：从左侧边缘道路到车站点中心线的垂直距离
第3列：从右边缘道路到车站点中心线的垂直距离

我们在图形中选择中心线的多段线，选择起点，然后选择文件。txt。

示例请下载附加文件。
请帮帮我！
测验txt文件
示例1.dwg

Tharwat · 发表于 2022-7-5 23:32:39

你好

试试这个惯例，让我知道你会怎么做。

copy


(defun c:Test (/ _ps _lw f o st l p s st nd pt ang e lst len)
 ;;    Author : Tharwat 30. Mar. 2014        ;;
 (if (and (setq f (getfiled "Select txt file :" "" "txt" 16))
          (setq o (open f "r"))
          (setq p (getpoint "\n Specify point at start point of Polyline :"))
          (setq s (ssget p '((0 . "LWPOLYLINE"))))
     )
   (progn
     (defun _ps (st / p v)
       (while (setq p (vl-string-position 9 st))
         (setq v  (cons (substr st 1 p) v)
               st (substr st (+ 2 p) (strlen st))
         )
       )
       (if st
         (setq v (cons st v))
       )
       (reverse v)
     )
     (while (setq st (read-line o)) (setq l (cons (_ps st) l)))
     (setq l (reverse l))
     (close o)
     (if (< (distance p (setq st (vlax-curve-getstartpoint (setq e (ssname s 0)))))
            (distance p (setq nd (vlax-curve-getendpoint e)))
         )
       (progn
         (setq p st)
         (foreach d l
           (if (setq ang (angle '(0.0 0.0 0.0)
                                (vlax-curve-getfirstderiv
                                  e
                                  (vlax-curve-getparamatpoint e (setq pt (vlax-curve-getpointatdist e (atof (car d)))))
                                )
                         )
               )
             (setq lst
                    (cons
                      (list (polar pt (+ (/ pi 2.) ang) (atof (cadr d))) (polar pt (- ang (/ pi 2.)) (atof (caddr d))))
                      lst
                    )
             )
           )
         )
       )
       (progn (setq len (vlax-curve-getdistatpoint e nd))
              (foreach d l
                (if (setq
                      ang (angle
                            '(0.0 0.0 0.0)
                            (vlax-curve-getfirstderiv
                              e
                              (vlax-curve-getparamatpoint e (setq pt (vlax-curve-getpointatdist e (- len (atof (car d))))))
                            )
                          )
                    )
                  (setq lst
                         (cons
                           (list (polar pt (+ (/ pi 2.) ang) (atof (cadr d))) (polar pt (- ang (/ pi 2.)) (atof (caddr d))))
                           lst
                         )
                  )
                )
              )
       )
     )
     (if (and lst (> (length lst) 1))
       (progn (defun _lw (pts)
                (entmakex (append (list '(0 . "LWPOLYLINE")
                                        '(100 . "AcDbEntity")
                                        '(100 . "AcDbPolyline")
                                        (cons 90 (length lst))
                                        '(70 . 0)
                                  )
                                  (mapcar '(lambda (x) (cons 10 x)) pts)
                          )
                )
              )
              (mapcar '_lw (list (mapcar 'car lst) (mapcar 'cadr lst)))
       )
     )
   )
   (princ "\n Invalid file or Picked isn't on Polyline !!")
 )
 (princ)
)(vl-load-com)

tieptouch · 发表于 2022-7-5 23:38:22

嗨，塔瓦，非常感谢你帮助我。这个惯例奏效了！
但是，如果在图形中未选择多段线，则当两条（或>2条）多段线具有公共起点时会发生什么情况？

prodromosm · 发表于 2022-7-5 23:48:52

干得好Tharwat。我可以问你一个问题吗。

a）如果我们有这样一个文件会怎么样
b）如果我想选择具有特定车站的道路中心线的特定点，会发生什么？

copy

0,3.5,3.6
20,3.4,3.6
45,3.6,3.5
70,3.5,3.4
100,3.4,3.6

谢谢

Tharwat · 发表于 2022-7-5 23:54:37

试着在例行程序中替换这个，并让我知道。

更换此。

copy

(while (setq p (vl-string-position 9 st))

用这个。

copy

(while (setq p (vl-string-position 44 st))

Tharwat · 发表于 2022-7-6 00:07:58

只有一个会被考虑。

prodromosm · 发表于 2022-7-6 00:17:01

好的，我换一下。
如果我想选择具有特定车站的道路中心线的特定点，会发生什么？我想给任何时候的起点不是一直为0，也不是一直都必须是多段线的起点或终点，必须是多段线的任何点。

实例

我有一条从4+500到8+400的路，我想把线从4+500偏移到6+200。首先我把点选到4+500，给起点桩号4+500，然后从4+500-->6+200加载文件

查看附加文件

copy


(defun c:Test (/ _ps _lw f o st l p s st nd pt ang e lst len)
 ;;    Author : Tharwat 30. Mar. 2014        ;;
 (if (and (setq f (getfiled "Select txt file :" "" "txt" 16))
          (setq o (open f "r"))
          (setq p (getpoint "\n Specify point at start point of Polyline :"))
          (setq s (ssget p '((0 . "LWPOLYLINE"))))
     )
   (progn
     (defun _ps (st / p v)
       (while (setq p (vl-string-position 44 st))
         (setq v  (cons (substr st 1 p) v)
               st (substr st (+ 2 p) (strlen st))
         )
       )
       (if st
         (setq v (cons st v))
       )
       (reverse v)
     )
     (while (setq st (read-line o)) (setq l (cons (_ps st) l)))
     (setq l (reverse l))
     (close o)
     (if (< (distance p (setq st (vlax-curve-getstartpoint (setq e (ssname s 0)))))
            (distance p (setq nd (vlax-curve-getendpoint e)))
         )
       (progn
         (setq p st)
         (foreach d l
           (if (setq ang (angle '(0.0 0.0 0.0)
                                (vlax-curve-getfirstderiv
                                  e
                                  (vlax-curve-getparamatpoint e (setq pt (vlax-curve-getpointatdist e (atof (car d)))))
                                )
                         )
               )
             (setq lst
                    (cons
                      (list (polar pt (+ (/ pi 2.) ang) (atof (cadr d))) (polar pt (- ang (/ pi 2.)) (atof (caddr d))))
                      lst
                    )
             )
           )
         )
       )
       (progn (setq len (vlax-curve-getdistatpoint e nd))
              (foreach d l
                (if (setq
                      ang (angle
                            '(0.0 0.0 0.0)
                            (vlax-curve-getfirstderiv
                              e
                              (vlax-curve-getparamatpoint e (setq pt (vlax-curve-getpointatdist e (- len (atof (car d))))))
                            )
                          )
                    )
                  (setq lst
                         (cons
                           (list (polar pt (+ (/ pi 2.) ang) (atof (cadr d))) (polar pt (- ang (/ pi 2.)) (atof (caddr d))))
                           lst
                         )
                  )
                )
              )
       )
     )
     (if (and lst (> (length lst) 1))
       (progn (defun _lw (pts)
                (entmakex (append (list '(0 . "LWPOLYLINE")
                                        '(100 . "AcDbEntity")
                                        '(100 . "AcDbPolyline")
                                        (cons 90 (length lst))
                                        '(70 . 0)
                                  )
                                  (mapcar '(lambda (x) (cons 10 x)) pts)
                          )
                )
              )
              (mapcar '_lw (list (mapcar 'car lst) (mapcar 'cadr lst)))
       )
     )
   )
   (princ "\n Invalid file or Picked isn't on Polyline !!")
 )
 (princ)
)(vl-load-com)

例子。图纸

prodromosm · 发表于 2022-7-6 00:24:03

我更新预览帖子

[编程交流] 需要帮助创建多段线e

发表回复

精选推荐