[gl]由多段线和标高值作地面线
最近有张图纸需要根据等高线画剖断面的地面线。作了一堆的辅助线，画起来相当烦躁，一地鸡毛。
想找LSP插件，没有找到。
于是抽空写了一个小程序，比较简陋，权当博君一笑。
本帖最后由 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) 占个座 谢谢分享！！！ 谢谢! brbright 分享程序!!!! 好像只根据起点、终点数据生成的，中间数据没用，不知道怎么回事 这个是例图，不知道怎么回事，没反应，求大神帮忙看一下
页:
[1]