[gl]由多段线和标高值作地面线

brbright · 发表于 2016-3-16 15:20:30

最近有张图纸需要根据等高线画剖断面的地面线。
作了一堆的辅助线，画起来相当烦躁，一地鸡毛。
想找LSP插件，没有找到。
于是抽空写了一个小程序，比较简陋，权当博君一笑。

brbright · 发表于 2016-3-16 15:21:01

本帖最后由 brbright 于 2016-3-16 15:26 编辑

;;;===由多段线和标高值作地面线===
;;;说明：
;;;选择多段线和文字，匹配文字中的标高数值
;;;匹配原则是顶点到文字插入点(InsertionPoint)最近
;;;从多段线的起点开始，从左到右作地面线
;;;X坐标增量取两顶点间的直线距离
;;;Y坐标增量取文字中的标高差值
(vl-load-com)
(defun c:gl (/ SPC
TX_ENT TX_TEXT
T_1 T_ENT
T_ENTSEL T_GROUND_LINE_VERTICES
T_GROUND_STARTPOINT T_HEIGHT_INCREMENT
T_NEAREST_TEXT T_POINT_X
T_POINT_Y T_POINT_Y_G
T_POLYLINE_VERTICES T_POLYLINE_VERTICES_NUM
T_SEGMENT_LENGTH_LIST T_SSFILTER
T_SSGET T_STARTPOINT_HEIGHT
T_TEXT_LIST T_VERTICES-TEXT_LIST
T_VERTICES-TEXT_LIST_INCREMENT
T_VERTICES_LIST T_VLA_VERTICES
)
;;选择多段线
(setq t_entsel (entsel "选择多段线，然后选择单行文字(标高数字)："))
;;选择文字
(setq t_ssfilter
'((-4 . "<OR")
(0 . "TEXT")
(0 . "MTEXT")
(-4 . "OR>")
)
)
(setq t_ssget (ssget t_ssfilter))
;;取得多段线、vla
(setq t_ent (car t_entsel))
(setq tx_ent (vlax-ename->vla-object t_ent))
;;取得多段线顶点表
(setq t_polyline_vertices
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property tx_ent 'Coordinates)
)
)
)
;;计算多段线顶点的数量
(setq t_polyline_vertices_num (/ (length t_polyline_vertices) 2))
;;获取顶点表
(setq t_vertices_list (list))
(setq t_1 0)
(repeat t_polyline_vertices_num
(setq t_vertices_list
(cons
(list (nth (* t_1 2) t_polyline_vertices)
(nth (+ 1 (* t_1 2)) t_polyline_vertices)
)
t_vertices_list
)
)
(setq t_1 (1+ t_1))
)
(setq t_vertices_list (reverse t_vertices_list))
;;计算各多段线的线段长度表
(setq t_segment_length_list (list))
(setq t_1 0)
(repeat (1- t_polyline_vertices_num)
(setq t_segment_length_list
(cons (distance
(nth t_1 t_vertices_list)
(nth (1+ t_1) t_vertices_list)
)
t_segment_length_list
)
)
(setq t_1 (1+ t_1))
)
(setq t_segment_length_list (reverse t_segment_length_list))
;;取得单行文字插入点数值及标高数值
(setq t_1 0)
(setq t_text_list (list))
(repeat (sslength t_ssget)
(setq tx_text (vlax-ename->vla-object (ssname t_ssget t_1)))
(setq t_text_list
(cons
(list (vlax-safearray->list
(vlax-variant-value (vla-get-InsertionPoint tx_text))
)
(atof (vla-get-TextString tx_text))
)
t_text_list
)
)
(setq t_1 (1+ t_1))
)
(reverse t_text_list)
;;按最近点原则为多段线顶点分配标高值
(setq t_vertices-text_list (list))
(foreach eachItem t_vertices_list
(setq t_nearest_text
(cdr (car (vl-sort
t_text_list
'(lambda (s1 s2)
(<
(distance
(car s1)
eachItem
)
(distance
(car s2)
eachItem
)
)
)
)
)
)
)
(setq t_vertices-text_list
(cons
(append (list eachItem) t_nearest_text)
t_vertices-text_list
)
)
)
(setq t_vertices-text_list (reverse t_vertices-text_list))
;;计算每一个标高值对多段线顶点标高值的差值
(setq t_vertices-text_list_increment (list))
(setq t_startpoint_height (cadr (car t_vertices-text_list)))
(foreach eachItem t_vertices-text_list
(setq t_height_increment (- (cadr eachItem) t_startpoint_height))
(setq t_vertices-text_list_increment
(cons (list (car eachItem) t_height_increment)
t_vertices-text_list_increment
)
)
)
(setq t_vertices-text_list_increment
(reverse
t_vertices-text_list_increment
)
)
;;构建地面线的多段线点表
(setq t_ground_line_vertices (list))
(setq t_ground_startpoint (car t_vertices_list))
(setq t_point_x (car t_ground_startpoint))
(setq t_point_y_g (cadr t_ground_startpoint))
(setq t_ground_line_vertices
(append t_ground_line_vertices
(list t_point_x t_point_y_g)
)
)
(setq t_1 1)
(repeat (1- t_polyline_vertices_num)
(setq t_point_x (+ t_point_x
(nth (1- t_1) t_segment_length_list)
)
)
(setq t_point_y (+ t_point_y_g
(cadr (nth t_1 t_vertices-text_list_increment))
)
)
(setq t_ground_line_vertices
(append t_ground_line_vertices
(list t_point_x t_point_y)
)
)
(print t_ground_line_vertices)
(setq t_1 (1+ t_1))
)
;;将地面线顶点表转换为vlisp能处理数据表
(setq t_vla_vertices
(vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length t_ground_line_vertices)))
)
)
(vlax-safearray-fill t_vla_vertices t_ground_line_vertices)
;;更新多段线顶点
(LM:activespace 'doc 'spc)
(vla-AddLightWeightPolyline
spc
t_vla_vertices
)
(princ)
)
;; Active Space - Lee Mac
;; Retrieves pointers to the Active Document and Space.
;; *doc - quoted symbol (other than *doc)
;; *spc - quoted symbol (other than *spc)
(defun LM:activespace (*doc *spc)
(set *doc (vla-get-activedocument (vlax-get-acad-object)))
(set *spc
(vlax-get-property
(eval *doc)
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
nil
)
(princ)

;;;===由多段线和标高值作地面线=== 
 
;;;说明： 
;;;选择多段线和文字，匹配文字中的标高数值 
;;;匹配原则是顶点到文字插入点(InsertionPoint)最近 
;;;从多段线的起点开始，从左到右作地面线 
;;;X坐标增量取两顶点间的直线距离 
;;;Y坐标增量取文字中的标高差值 
(vl-load-com) 
(defun c:gl (/                           SPC 
             TX_ENT                   TX_TEXT 
             T_1                   T_ENT 
             T_ENTSEL                   T_GROUND_LINE_VERTICES 
             T_GROUND_STARTPOINT   T_HEIGHT_INCREMENT 
             T_NEAREST_TEXT           T_POINT_X 
             T_POINT_Y                   T_POINT_Y_G 
             T_POLYLINE_VERTICES   T_POLYLINE_VERTICES_NUM 
             T_SEGMENT_LENGTH_LIST T_SSFILTER 
             T_SSGET                   T_STARTPOINT_HEIGHT 
             T_TEXT_LIST           T_VERTICES-TEXT_LIST 
             T_VERTICES-TEXT_LIST_INCREMENT 
             T_VERTICES_LIST           T_VLA_VERTICES 
            ) 
  ;;选择多段线 
  (setq t_entsel (entsel "选择多段线，然后选择单行文字(标高数字)：")) 
  ;;选择文字 
  (setq        t_ssfilter 
         '((-4 . "<OR") 
           (0 . "TEXT") 
           (0 . "MTEXT") 
           (-4 . "OR>") 
          ) 
  ) 
  (setq t_ssget (ssget t_ssfilter)) 
  ;;取得多段线、vla 
  (setq t_ent (car t_entsel)) 
  (setq tx_ent (vlax-ename->vla-object t_ent)) 
  ;;取得多段线顶点表 
  (setq        t_polyline_vertices 
         (vlax-safearray->list 
           (vlax-variant-value 
             (vlax-get-property tx_ent 'Coordinates) 
           ) 
         ) 
  ) 
 
  ;;计算多段线顶点的数量 
  (setq t_polyline_vertices_num (/ (length t_polyline_vertices) 2)) 
  ;;获取顶点表 
  (setq t_vertices_list (list)) 
  (setq t_1 0) 
  (repeat t_polyline_vertices_num 
    (setq t_vertices_list 
           (cons 
             (list (nth (* t_1 2) t_polyline_vertices) 
                   (nth (+ 1 (* t_1 2)) t_polyline_vertices) 
             ) 
             t_vertices_list 
           ) 
    ) 
    (setq t_1 (1+ t_1)) 
  ) 
  (setq t_vertices_list (reverse t_vertices_list)) 
  ;;计算各多段线的线段长度表 
  (setq t_segment_length_list (list)) 
  (setq t_1 0) 
  (repeat (1- t_polyline_vertices_num) 
    (setq t_segment_length_list 
           (cons (distance 
                   (nth t_1 t_vertices_list) 
                   (nth (1+ t_1) t_vertices_list) 
 
                 ) 
                 t_segment_length_list 
           ) 
    ) 
    (setq t_1 (1+ t_1)) 
  ) 
  (setq t_segment_length_list (reverse t_segment_length_list)) 
  ;;取得单行文字插入点数值及标高数值 
  (setq t_1 0) 
  (setq t_text_list (list)) 
  (repeat (sslength t_ssget) 
    (setq tx_text (vlax-ename->vla-object (ssname t_ssget t_1))) 
    (setq t_text_list 
           (cons 
             (list (vlax-safearray->list 
                     (vlax-variant-value (vla-get-InsertionPoint tx_text)) 
                   ) 
                   (atof (vla-get-TextString tx_text)) 
             ) 
             t_text_list 
           ) 
    ) 
    (setq t_1 (1+ t_1)) 
  ) 
  (reverse t_text_list) 
  ;;按最近点原则为多段线顶点分配标高值 
  (setq t_vertices-text_list (list)) 
  (foreach eachItem t_vertices_list 
    (setq t_nearest_text 
           (cdr        (car (vl-sort 
                       t_text_list 
                       '(lambda        (s1 s2) 
                          (< 
                            (distance 
                              (car s1) 
                              eachItem 
                            ) 
                            (distance 
                              (car s2) 
                              eachItem 
                            ) 
                          ) 
                        ) 
                     ) 
                ) 
           ) 
    ) 
    (setq t_vertices-text_list 
           (cons 
             (append (list eachItem) t_nearest_text) 
             t_vertices-text_list 
           ) 
    ) 
  ) 
  (setq t_vertices-text_list (reverse t_vertices-text_list)) 
  ;;计算每一个标高值对多段线顶点标高值的差值 
  (setq t_vertices-text_list_increment (list)) 
  (setq t_startpoint_height (cadr (car t_vertices-text_list))) 
  (foreach eachItem t_vertices-text_list 
    (setq t_height_increment (- (cadr eachItem) t_startpoint_height)) 
    (setq t_vertices-text_list_increment 
           (cons (list (car eachItem) t_height_increment) 
                 t_vertices-text_list_increment 
           ) 
    ) 
  ) 
  (setq        t_vertices-text_list_increment 
         (reverse 
           t_vertices-text_list_increment 
         ) 
  ) 
  ;;构建地面线的多段线点表 
  (setq t_ground_line_vertices (list)) 
  (setq t_ground_startpoint (car t_vertices_list)) 
 
  (setq t_point_x (car t_ground_startpoint)) 
  (setq t_point_y_g (cadr t_ground_startpoint)) 
 
  (setq        t_ground_line_vertices 
         (append t_ground_line_vertices 
                 (list t_point_x t_point_y_g) 
         ) 
  ) 
  (setq t_1 1) 
  (repeat (1- t_polyline_vertices_num) 
    (setq t_point_x (+ t_point_x 
                       (nth (1- t_1) t_segment_length_list) 
                    ) 
    ) 
    (setq t_point_y (+ t_point_y_g 
                       (cadr (nth t_1 t_vertices-text_list_increment)) 
                    ) 
    ) 
    (setq t_ground_line_vertices 
           (append t_ground_line_vertices 
                   (list t_point_x t_point_y) 
           ) 
    ) 
    (print t_ground_line_vertices) 
    (setq t_1 (1+ t_1)) 
  ) 
  ;;将地面线顶点表转换为vlisp能处理数据表 
  (setq        t_vla_vertices 
         (vlax-make-safearray 
           vlax-vbDouble 
           (cons 0 (1- (length t_ground_line_vertices))) 
         ) 
  ) 
  (vlax-safearray-fill t_vla_vertices t_ground_line_vertices) 
  ;;更新多段线顶点 
  (LM:activespace 'doc 'spc) 
  (vla-AddLightWeightPolyline 
    spc 
    t_vla_vertices 
  ) 
  (princ) 
) 
 
;; Active Space  -  Lee Mac 
;; Retrieves pointers to the Active Document and Space. 
;; *doc - quoted symbol (other than *doc) 
;; *spc - quoted symbol (other than *spc) 
(defun LM:activespace (*doc *spc) 
  (set *doc (vla-get-activedocument (vlax-get-acad-object))) 
  (set *spc 
       (vlax-get-property 
         (eval *doc) 
         (if (= 1 (getvar 'cvport)) 
           'paperspace 
           'modelspace 
         ) 
       ) 
  ) 
  nil 
) 
(princ)

永不言弃 · 发表于 2016-3-16 15:47:33

占个座

730527 · 发表于 2019-3-12 21:08:55

谢谢分享！！！

yoyoho · 发表于 2019-3-13 00:37:09

谢谢! brbright 分享程序!!!!

yangchao2005090 · 发表于 2020-7-11 12:50:51

好像只根据起点、终点数据生成的，中间数据没用，不知道怎么回事

yangchao2005090 · 发表于 2020-7-27 09:48:09

这个是例图，不知道怎么回事，没反应，求大神帮忙看一下

账号		自动登录	找回密码
密码			注册

[源码] [gl]由多段线和标高值作地面线

本帖子中包含更多资源

相关帖子

本帖子中包含更多资源