关于多段线加点的问题

boylovecfy · 发表于 2022-6-21 15:25

小弟在网上拼凑了点代码，期待实现批量从外部读取坐标对多段线加点，但是一直有问题，函数调用的时候，小菜一个，求大神指点迷津

(vl-load-com)
(DEFUN C:DXJD()
(setq ffn (getfiled "????" "" "txt" 1))
(setq ff (open ffn "r"))
(setq data (read-line ff))
(LIST DATA)
(print "请选择多段线")
(setq EN (entsel))
(WHILE DATA
(setq data(t11 data ","))
(SETQ DATAX (atof (nth 0 data )))
(SETQ DATAY (atof (nth 1 data )))
(setq datalist (list datax datay))
(VA EN datalist)
(setq data (read-line ff))
)
(close ff)
)
(defun va (t_entsel datalist/ t_getpoint tx_ent t_1
t_ent
t_near_point t_param_line t_param_near
t_polyline_bulges t_polyline_vertices
t_polyline_vertices_num t_sel_point
t_vla_vertices
)
;;选择多段线
(setq t_ent (car t_entsel))
(setq t_sel_point (cadr t_entsel))
(setq tx_ent (vlax-ename->vla-object t_ent))
;;捕捉多段线上到选择点的最近点
(setq t_near_point
(vlax-curve-getclosestpointto
tx_ent
(trans t_sel_point 1 0)
)
)
;;计算最近点在多段线上的标记，四舍五入取整获得选择点的最近顶点标记,从0算起
(setq
t_param_near
(fix (+ (vlax-curve-getparamatpoint tx_ent t_near_point)
0.5
)
)
)
;;计算最近点在多段线上的标记，取整获得线段起点顶点标记,从0算起
(setq
t_param_line
(fix (vlax-curve-getparamatpoint tx_ent t_near_point)
)
)
;;因为弧线段要加顶点，需要注意的地方较多，建议手工处理
(if (= (vla-getbulge tx_ent t_param_line) 0.0)
(princ)
(progn
(princ "\n这是弧线段,建议手工处理,程序退出")
(exit)
)
)
;;取得多段线顶点表
(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_polyline_bulges (list))
(setq t_1 0)
(repeat t_polyline_vertices_num
(setq t_polyline_bulges
(cons (vla-getbulge tx_ent t_1)
t_polyline_bulges
)
)
(setq t_1 (1+ t_1))
)
(setq t_polyline_bulges (reverse t_polyline_bulges))
;;选择新点
;;选择新点
;;选择新点
(setq t_getpoint (trans (datalist) 1 0))
;;在点表添加点
(cond
;;检测到第一点，起点前加点，表头加点
((= t_param_near 0)
(setq t_polyline_vertices
(cons (cadr t_getpoint) t_polyline_vertices)
)
(setq t_polyline_vertices
(cons (car t_getpoint) t_polyline_vertices)
)
)
;;检测到终点，终点后加点，表尾加点
((= t_param_near (1- t_polyline_vertices_num))
(setq t_polyline_vertices
(append
t_polyline_vertices
(list (car t_getpoint) (cadr t_getpoint))
)
)
)
;;其他则在多段线线段中间加直线，表中间加点
(t
(progn
(setq t_polyline_vertices
(br:insertnth
t_polyline_vertices
(+ (* 2 t_param_line) 2)
(cadr t_getpoint)
)
)
(setq t_polyline_vertices
(br:insertnth
t_polyline_vertices
(+ (* 2 t_param_line) 2)
(car t_getpoint)
)
)
)
)
)
;;凸度表加零
(setq t_polyline_bulges
(br:insertnth t_polyline_bulges t_param_line 0.0)
)
;;将多段线顶点表转换为vlisp能处理数据表
(setq t_vla_vertices
(vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length t_polyline_vertices)))
)
)
(vlax-safearray-fill t_vla_vertices t_polyline_vertices)
;;更新多段线顶点
(vlax-put-property tx_ent 'Coordinates t_vla_vertices)
;;更新多段线凸度
(setq t_1 0)
(repeat (length t_polyline_bulges)
(vla-setbulge
tx_ent
t_1
(nth t_1 t_polyline_bulges)
)
(setq t_1 (1+ t_1))
)
(princ)
)
;;删除顶点
(defun c:vd (/ tx_ent t_1
t_ent t_entsel t_getpoint
t_near_point t_param_line t_param_near
t_polyline_bulges t_polyline_vertices
t_polyline_vertices_num t_sel_point
t_vla_vertices
)
;;选择多段线
(setq t_entsel (entsel))
;;取得多段线、选择点、vla
(setq t_ent (car t_entsel))
(setq t_sel_point (cadr t_entsel))
(setq tx_ent (vlax-ename->vla-object t_ent))
;;捕捉多段线上到选择点的最近点
(setq t_near_point
(vlax-curve-getclosestpointto
tx_ent
(trans t_sel_point 1 0)
)
)
;;计算最近点在多段线上的标记，四舍五入取整获得选择点的最近顶点标记,从0算起
(setq
t_param_near
(fix (+ (vlax-curve-getparamatpoint tx_ent t_near_point)
0.5
)
)
)
;;计算最近点在多段线上的标记，取整获得线段起点顶点标记,从0算起
(setq
t_param_line
(fix (vlax-curve-getparamatpoint tx_ent t_near_point)
)
)
;;因为弧线段要加顶点，需要注意的地方较多，建议手工处理
(if (= (vla-getbulge tx_ent t_param_near) 0.0)
(princ)
(progn
(princ "\n这是弧线段,建议手工处理,程序退出")
(exit)
)
)
(if (< t_param_near 1)
(princ)
(progn (if (= (vla-getbulge tx_ent (1- t_param_near)) 0.0)
(princ)
(progn
(princ "\n这是弧线段,建议手工处理,程序退出")
(exit)
)
)
)
)
;;取得多段线顶点表
(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_polyline_bulges (list))
(setq t_1 0)
(repeat t_polyline_vertices_num
(setq t_polyline_bulges
(cons (vla-getbulge tx_ent t_1)
t_polyline_bulges
)
)
(setq t_1 (1+ t_1))
)
(setq t_polyline_bulges (reverse t_polyline_bulges))
;;在点表删除点
(cond
;;检测到第一点，起点删除点，表头删除点
((= t_param_near 0)
(setq t_polyline_vertices
(cdr t_polyline_vertices)
)
(setq t_polyline_vertices
(cdr t_polyline_vertices)
)
)
;;检测到终点，终点删除点，表尾删除点
((= t_param_near (1- t_polyline_vertices_num))
(setq t_polyline_vertices (reverse t_polyline_vertices))
(setq t_polyline_vertices
(cdr t_polyline_vertices)
)
(setq t_polyline_vertices
(cdr t_polyline_vertices)
)
(setq t_polyline_vertices (reverse t_polyline_vertices))
)
;;其他则在多段线线段中间删点，表中间删点
(t
(progn
(setq t_polyline_vertices
(LM:RemoveNth
(+ (* 2 t_param_near) 0)
t_polyline_vertices
)
)
(setq t_polyline_vertices
(LM:RemoveNth
(+ (* 2 t_param_near) 0)
t_polyline_vertices
)
)
)
)
)
;;凸度表删凸度
(setq t_polyline_bulges
(LM:RemoveNth t_param_line t_polyline_bulges)
)
;;将多段线顶点表转换为vlisp能处理数据表
(setq t_vla_vertices
(vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length t_polyline_vertices)))
)
)
(vlax-safearray-fill t_vla_vertices t_polyline_vertices)
;;更新多段线顶点
(vlax-put-property tx_ent 'Coordinates t_vla_vertices)
;;更新多段线凸度
(setq t_1 0)
(repeat (length t_polyline_bulges)
(vla-setbulge
tx_ent
t_1
(nth t_1 t_polyline_bulges)
)
(setq t_1 (1+ t_1))
)
(princ)
)
;;自编函数，在列表中插入元素
;;自编函数，在列表中插入元素
;;自编函数，在列表中插入元素
(defun br:insertnth (t_list t_n t_new /
t_1 t_list_1 t_list_2 t_list_new
t_list_num
)
(setq t_n (fix t_n))
(setq t_list_num (length t_list))
(setq t_list_new (list t_new))
(cond ((= t_n 0)
(setq t_list (append t_list_new t_list))
)
((= t_n t_list_num)
(setq t_list (append t_list t_list_new))
)
((> t_n t_list_num) (print "[error](br:insertnth) n > length"))
(t
(progn
(setq t_list_1 (list))
(setq t_list_2 (list))
(setq t_1 (1- t_n))
(repeat t_n
(setq t_list_1 (cons (nth t_1 t_list) t_list_1))
(setq t_1 (1- t_1))
)
(setq t_1 (1- t_list_num))
(repeat (- t_list_num t_n)
(setq t_list_2 (cons (nth t_1 t_list) t_list_2))
(setq t_1 (1- t_1))
)
(setq t_list (append t_list_1 t_list_new t_list_2))
)
)
)
t_list
)
;;----------------------=={ Remove Nth }==--------------------;;
;; ;;
;; Removes the item at the nth index in a supplied list ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; n - index of item to remove (zero based) ;;
;; l - list from which item is to be removed ;;
;;------------------------------------------------------------;;
;; Returns: List with item at index n removed ;;
;;------------------------------------------------------------;;
(defun LM:RemoveNth ( n l / i )
(setq i -1)
(vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l)
)
(defun t11 (str del / pos lst)
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ 1 pos (strlen del)))
)
)
(reverse (cons str lst))
)

(vl-load-com) 
(DEFUN C:DXJD() 
  (setq ffn (getfiled "????" "" "txt" 1)) 
  (setq ff (open ffn "r")) 
  (setq data (read-line ff)) 
  (LIST DATA) 
  (print "请选择多段线") 
  (setq EN (entsel)) 
  (WHILE DATA 
    (setq data(t11 data ",")) 
    (SETQ DATAX (atof (nth 0 data ))) 
    (SETQ DATAY (atof (nth 1 data ))) 
    (setq datalist (list datax datay)) 
    (VA EN datalist) 
    (setq data (read-line ff)) 
) 
  (close ff) 
) 
 
 
 
(defun va (t_entsel    datalist/    t_getpoint  tx_ent       t_1 
    t_ent          
    t_near_point  t_param_line     t_param_near 
    t_polyline_bulges  t_polyline_vertices 
    t_polyline_vertices_num       t_sel_point 
    t_vla_vertices 
  ) 
  ;;选择多段线 
  (setq t_ent (car t_entsel)) 
  (setq t_sel_point (cadr t_entsel)) 
  (setq tx_ent (vlax-ename->vla-object t_ent)) 
  ;;捕捉多段线上到选择点的最近点 
  (setq  t_near_point 
    (vlax-curve-getclosestpointto 
      tx_ent 
      (trans t_sel_point 1 0) 
    ) 
  ) 
  ;;计算最近点在多段线上的标记，四舍五入取整获得选择点的最近顶点标记,从0算起 
  (setq 
    t_param_near 
    (fix (+ (vlax-curve-getparamatpoint tx_ent t_near_point) 
        0.5 
      ) 
    ) 
  ) 
  ;;计算最近点在多段线上的标记，取整获得线段起点顶点标记,从0算起 
  (setq 
    t_param_line 
    (fix (vlax-curve-getparamatpoint tx_ent t_near_point) 
    ) 
  ) 
  ;;因为弧线段要加顶点，需要注意的地方较多，建议手工处理 
  (if (= (vla-getbulge tx_ent t_param_line) 0.0) 
    (princ) 
    (progn 
      (princ "\n这是弧线段,建议手工处理,程序退出") 
      (exit) 
    ) 
  ) 
  ;;取得多段线顶点表 
  (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_polyline_bulges (list)) 
  (setq t_1 0) 
  (repeat t_polyline_vertices_num 
    (setq t_polyline_bulges 
      (cons (vla-getbulge tx_ent t_1) 
        t_polyline_bulges 
      ) 
    ) 
    (setq t_1 (1+ t_1)) 
  ) 
  (setq t_polyline_bulges (reverse t_polyline_bulges)) 
  ;;选择新点 
  ;;选择新点 
  ;;选择新点 
  (setq t_getpoint (trans (datalist) 1 0)) 
  ;;在点表添加点 
  (cond 
    ;;检测到第一点，起点前加点，表头加点 
    ((= t_param_near 0) 
      (setq t_polyline_vertices 
        (cons (cadr t_getpoint) t_polyline_vertices) 
      ) 
      (setq t_polyline_vertices 
        (cons (car t_getpoint) t_polyline_vertices) 
      ) 
    ) 
    ;;检测到终点，终点后加点，表尾加点 
    ((= t_param_near (1- t_polyline_vertices_num)) 
      (setq t_polyline_vertices 
        (append 
          t_polyline_vertices 
          (list (car t_getpoint) (cadr t_getpoint)) 
        ) 
      ) 
    ) 
    ;;其他则在多段线线段中间加直线，表中间加点 
    (t 
      (progn 
        (setq t_polyline_vertices 
          (br:insertnth 
            t_polyline_vertices 
            (+ (* 2 t_param_line) 2) 
            (cadr t_getpoint) 
          ) 
        ) 
        (setq t_polyline_vertices 
          (br:insertnth 
            t_polyline_vertices 
            (+ (* 2 t_param_line) 2) 
            (car t_getpoint) 
          ) 
        ) 
      ) 
    ) 
  ) 
  ;;凸度表加零 
  (setq  t_polyline_bulges 
    (br:insertnth t_polyline_bulges t_param_line 0.0) 
  ) 
  ;;将多段线顶点表转换为vlisp能处理数据表 
  (setq  t_vla_vertices 
    (vlax-make-safearray 
      vlax-vbDouble 
      (cons 0 (1- (length t_polyline_vertices))) 
    ) 
  ) 
  (vlax-safearray-fill t_vla_vertices t_polyline_vertices) 
  ;;更新多段线顶点 
  (vlax-put-property tx_ent 'Coordinates t_vla_vertices) 
  ;;更新多段线凸度 
  (setq t_1 0) 
  (repeat (length t_polyline_bulges) 
    (vla-setbulge 
      tx_ent 
      t_1 
      (nth t_1 t_polyline_bulges) 
    ) 
    (setq t_1 (1+ t_1)) 
  ) 
  (princ) 
) 
 
;;删除顶点 
(defun c:vd (/      tx_ent       t_1 
    t_ent    t_entsel     t_getpoint 
    t_near_point  t_param_line     t_param_near 
    t_polyline_bulges  t_polyline_vertices 
    t_polyline_vertices_num       t_sel_point 
    t_vla_vertices 
  ) 
  ;;选择多段线 
  (setq t_entsel (entsel)) 
  ;;取得多段线、选择点、vla 
  (setq t_ent (car t_entsel)) 
  (setq t_sel_point (cadr t_entsel)) 
  (setq tx_ent (vlax-ename->vla-object t_ent)) 
  ;;捕捉多段线上到选择点的最近点 
  (setq  t_near_point 
    (vlax-curve-getclosestpointto 
      tx_ent 
      (trans t_sel_point 1 0) 
    ) 
  ) 
  ;;计算最近点在多段线上的标记，四舍五入取整获得选择点的最近顶点标记,从0算起 
  (setq 
    t_param_near 
    (fix (+ (vlax-curve-getparamatpoint tx_ent t_near_point) 
        0.5 
      ) 
    ) 
  ) 
  ;;计算最近点在多段线上的标记，取整获得线段起点顶点标记,从0算起 
  (setq 
    t_param_line 
    (fix (vlax-curve-getparamatpoint tx_ent t_near_point) 
    ) 
  ) 
  ;;因为弧线段要加顶点，需要注意的地方较多，建议手工处理 
  (if (= (vla-getbulge tx_ent t_param_near) 0.0) 
    (princ) 
    (progn 
      (princ "\n这是弧线段,建议手工处理,程序退出") 
      (exit) 
    ) 
  ) 
  (if (< t_param_near 1) 
    (princ) 
    (progn (if (= (vla-getbulge tx_ent (1- t_param_near)) 0.0) 
        (princ) 
        (progn 
          (princ "\n这是弧线段,建议手工处理,程序退出") 
          (exit) 
        ) 
      ) 
    ) 
  ) 
  ;;取得多段线顶点表 
  (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_polyline_bulges (list)) 
  (setq t_1 0) 
  (repeat t_polyline_vertices_num 
    (setq t_polyline_bulges 
      (cons (vla-getbulge tx_ent t_1) 
        t_polyline_bulges 
      ) 
    ) 
    (setq t_1 (1+ t_1)) 
  ) 
  (setq t_polyline_bulges (reverse t_polyline_bulges)) 
  ;;在点表删除点 
  (cond 
    ;;检测到第一点，起点删除点，表头删除点 
    ((= t_param_near 0) 
      (setq t_polyline_vertices 
        (cdr t_polyline_vertices) 
      ) 
      (setq t_polyline_vertices 
        (cdr t_polyline_vertices) 
      ) 
    ) 
    ;;检测到终点，终点删除点，表尾删除点 
    ((= t_param_near (1- t_polyline_vertices_num)) 
      (setq t_polyline_vertices (reverse t_polyline_vertices)) 
      (setq t_polyline_vertices 
        (cdr t_polyline_vertices) 
      ) 
      (setq t_polyline_vertices 
        (cdr t_polyline_vertices) 
      ) 
      (setq t_polyline_vertices (reverse t_polyline_vertices)) 
    ) 
    ;;其他则在多段线线段中间删点，表中间删点 
    (t 
      (progn 
        (setq t_polyline_vertices 
          (LM:RemoveNth 
            (+ (* 2 t_param_near) 0) 
            t_polyline_vertices 
          ) 
        ) 
        (setq t_polyline_vertices 
          (LM:RemoveNth 
            (+ (* 2 t_param_near) 0) 
            t_polyline_vertices 
          ) 
        ) 
      ) 
    ) 
  ) 
  ;;凸度表删凸度 
  (setq  t_polyline_bulges 
    (LM:RemoveNth t_param_line t_polyline_bulges) 
  ) 
  ;;将多段线顶点表转换为vlisp能处理数据表 
  (setq  t_vla_vertices 
    (vlax-make-safearray 
      vlax-vbDouble 
      (cons 0 (1- (length t_polyline_vertices))) 
    ) 
  ) 
  (vlax-safearray-fill t_vla_vertices t_polyline_vertices) 
  ;;更新多段线顶点 
  (vlax-put-property tx_ent 'Coordinates t_vla_vertices) 
  ;;更新多段线凸度 
  (setq t_1 0) 
  (repeat (length t_polyline_bulges) 
    (vla-setbulge 
      tx_ent 
      t_1 
      (nth t_1 t_polyline_bulges) 
    ) 
    (setq t_1 (1+ t_1)) 
  ) 
  (princ) 
) 
;;自编函数，在列表中插入元素 
;;自编函数，在列表中插入元素 
;;自编函数，在列表中插入元素 
(defun br:insertnth (t_list  t_n     t_new      / 
    t_1  t_list_1   t_list_2   t_list_new 
    t_list_num 
  ) 
  (setq t_n (fix t_n)) 
  (setq t_list_num (length t_list)) 
  (setq t_list_new (list t_new)) 
  (cond  ((= t_n 0) 
      (setq t_list (append t_list_new t_list)) 
    ) 
    ((= t_n t_list_num) 
      (setq t_list (append t_list t_list_new)) 
    ) 
    ((> t_n t_list_num) (print "[error](br:insertnth) n > length")) 
    (t 
      (progn 
        (setq t_list_1 (list)) 
        (setq t_list_2 (list)) 
        (setq t_1 (1- t_n)) 
        (repeat t_n 
          (setq t_list_1 (cons (nth t_1 t_list) t_list_1)) 
          (setq t_1 (1- t_1)) 
        ) 
         
        (setq t_1 (1- t_list_num)) 
        (repeat (- t_list_num t_n) 
          (setq t_list_2 (cons (nth t_1 t_list) t_list_2)) 
          (setq t_1 (1- t_1)) 
        ) 
        (setq t_list (append t_list_1 t_list_new t_list_2)) 
      ) 
    ) 
    
  ) 
  t_list 
) 
 
;;----------------------=={ Remove Nth }==--------------------;; 
;;                                                            ;; 
;;  Removes the item at the nth index in a supplied list      ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com       ;; 
;;------------------------------------------------------------;; 
;;  Arguments:                                                ;; 
;;  n - index of item to remove (zero based)                  ;; 
;;  l - list from which item is to be removed                 ;; 
;;------------------------------------------------------------;; 
;;  Returns:  List with item at index n removed               ;; 
;;------------------------------------------------------------;; 
 
(defun LM:RemoveNth ( n l / i ) 
  (setq i -1) 
  (vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l) 
) 
 
(defun t11 (str del / pos lst) 
  (while (setq pos (vl-string-search del str)) 
    (setq lst (cons (substr str 1 pos) lst) 
      str (substr str (+ 1 pos (strlen del))) 
    ) 
  ) 
  (reverse (cons str lst)) 
)

wzg356 · 发表于 2022-6-21 19:35

http://bbs.mjtd.com/thread-182471-1-1.html

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

[提问] 关于多段线加点的问题