明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 125|回复: 1

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

[复制链接]
发表于 2022-6-21 15:25 | 显示全部楼层 |阅读模式
小弟在网上拼凑了点代码,期待实现批量从外部读取坐标对多段线加点,但是一直有问题,函数调用的时候,小菜一个,求大神指点迷津
  1. (vl-load-com)
  2. (DEFUN C:DXJD()
  3.   (setq ffn (getfiled "????" "" "txt" 1))
  4.   (setq ff (open ffn "r"))
  5.   (setq data (read-line ff))
  6.   (LIST DATA)
  7.   (print "请选择多段线")
  8.   (setq EN (entsel))
  9.   (WHILE DATA
  10.     (setq data(t11 data ","))
  11.     (SETQ DATAX (atof (nth 0 data )))
  12.     (SETQ DATAY (atof (nth 1 data )))
  13.     (setq datalist (list datax datay))
  14.     (VA EN datalist)
  15.     (setq data (read-line ff))
  16. )
  17.   (close ff)
  18. )



  19. (defun va (t_entsel    datalist/    t_getpoint  tx_ent       t_1
  20.     t_ent         
  21.     t_near_point  t_param_line     t_param_near
  22.     t_polyline_bulges  t_polyline_vertices
  23.     t_polyline_vertices_num       t_sel_point
  24.     t_vla_vertices
  25.   )
  26.   ;;选择多段线
  27.   (setq t_ent (car t_entsel))
  28.   (setq t_sel_point (cadr t_entsel))
  29.   (setq tx_ent (vlax-ename->vla-object t_ent))
  30.   ;;捕捉多段线上到选择点的最近点
  31.   (setq  t_near_point
  32.     (vlax-curve-getclosestpointto
  33.       tx_ent
  34.       (trans t_sel_point 1 0)
  35.     )
  36.   )
  37.   ;;计算最近点在多段线上的标记,四舍五入取整获得选择点的最近顶点标记,从0算起
  38.   (setq
  39.     t_param_near
  40.     (fix (+ (vlax-curve-getparamatpoint tx_ent t_near_point)
  41.         0.5
  42.       )
  43.     )
  44.   )
  45.   ;;计算最近点在多段线上的标记,取整获得线段起点顶点标记,从0算起
  46.   (setq
  47.     t_param_line
  48.     (fix (vlax-curve-getparamatpoint tx_ent t_near_point)
  49.     )
  50.   )
  51.   ;;因为弧线段要加顶点,需要注意的地方较多,建议手工处理
  52.   (if (= (vla-getbulge tx_ent t_param_line) 0.0)
  53.     (princ)
  54.     (progn
  55.       (princ "\n这是弧线段,建议手工处理,程序退出")
  56.       (exit)
  57.     )
  58.   )
  59.   ;;取得多段线顶点表
  60.   (setq  t_polyline_vertices
  61.     (vlax-safearray->list
  62.       (vlax-variant-value
  63.         (vlax-get-property tx_ent 'Coordinates)
  64.       )
  65.     )
  66.   )
  67.   ;;计算多段线顶点的数量
  68.   (setq t_polyline_vertices_num (/ (length t_polyline_vertices) 2))
  69.   ;;记录多段线凸度值表
  70.   (setq t_polyline_bulges (list))
  71.   (setq t_1 0)
  72.   (repeat t_polyline_vertices_num
  73.     (setq t_polyline_bulges
  74.       (cons (vla-getbulge tx_ent t_1)
  75.         t_polyline_bulges
  76.       )
  77.     )
  78.     (setq t_1 (1+ t_1))
  79.   )
  80.   (setq t_polyline_bulges (reverse t_polyline_bulges))
  81.   ;;选择新点
  82.   ;;选择新点
  83.   ;;选择新点
  84.   (setq t_getpoint (trans (datalist) 1 0))
  85.   ;;在点表添加点
  86.   (cond
  87.     ;;检测到第一点,起点前加点,表头加点
  88.     ((= t_param_near 0)
  89.       (setq t_polyline_vertices
  90.         (cons (cadr t_getpoint) t_polyline_vertices)
  91.       )
  92.       (setq t_polyline_vertices
  93.         (cons (car t_getpoint) t_polyline_vertices)
  94.       )
  95.     )
  96.     ;;检测到终点,终点后加点,表尾加点
  97.     ((= t_param_near (1- t_polyline_vertices_num))
  98.       (setq t_polyline_vertices
  99.         (append
  100.           t_polyline_vertices
  101.           (list (car t_getpoint) (cadr t_getpoint))
  102.         )
  103.       )
  104.     )
  105.     ;;其他则在多段线线段中间加直线,表中间加点
  106.     (t
  107.       (progn
  108.         (setq t_polyline_vertices
  109.           (br:insertnth
  110.             t_polyline_vertices
  111.             (+ (* 2 t_param_line) 2)
  112.             (cadr t_getpoint)
  113.           )
  114.         )
  115.         (setq t_polyline_vertices
  116.           (br:insertnth
  117.             t_polyline_vertices
  118.             (+ (* 2 t_param_line) 2)
  119.             (car t_getpoint)
  120.           )
  121.         )
  122.       )
  123.     )
  124.   )
  125.   ;;凸度表加零
  126.   (setq  t_polyline_bulges
  127.     (br:insertnth t_polyline_bulges t_param_line 0.0)
  128.   )
  129.   ;;将多段线顶点表转换为vlisp能处理数据表
  130.   (setq  t_vla_vertices
  131.     (vlax-make-safearray
  132.       vlax-vbDouble
  133.       (cons 0 (1- (length t_polyline_vertices)))
  134.     )
  135.   )
  136.   (vlax-safearray-fill t_vla_vertices t_polyline_vertices)
  137.   ;;更新多段线顶点
  138.   (vlax-put-property tx_ent 'Coordinates t_vla_vertices)
  139.   ;;更新多段线凸度
  140.   (setq t_1 0)
  141.   (repeat (length t_polyline_bulges)
  142.     (vla-setbulge
  143.       tx_ent
  144.       t_1
  145.       (nth t_1 t_polyline_bulges)
  146.     )
  147.     (setq t_1 (1+ t_1))
  148.   )
  149.   (princ)
  150. )

  151. ;;删除顶点
  152. (defun c:vd (/      tx_ent       t_1
  153.     t_ent    t_entsel     t_getpoint
  154.     t_near_point  t_param_line     t_param_near
  155.     t_polyline_bulges  t_polyline_vertices
  156.     t_polyline_vertices_num       t_sel_point
  157.     t_vla_vertices
  158.   )
  159.   ;;选择多段线
  160.   (setq t_entsel (entsel))
  161.   ;;取得多段线、选择点、vla
  162.   (setq t_ent (car t_entsel))
  163.   (setq t_sel_point (cadr t_entsel))
  164.   (setq tx_ent (vlax-ename->vla-object t_ent))
  165.   ;;捕捉多段线上到选择点的最近点
  166.   (setq  t_near_point
  167.     (vlax-curve-getclosestpointto
  168.       tx_ent
  169.       (trans t_sel_point 1 0)
  170.     )
  171.   )
  172.   ;;计算最近点在多段线上的标记,四舍五入取整获得选择点的最近顶点标记,从0算起
  173.   (setq
  174.     t_param_near
  175.     (fix (+ (vlax-curve-getparamatpoint tx_ent t_near_point)
  176.         0.5
  177.       )
  178.     )
  179.   )
  180.   ;;计算最近点在多段线上的标记,取整获得线段起点顶点标记,从0算起
  181.   (setq
  182.     t_param_line
  183.     (fix (vlax-curve-getparamatpoint tx_ent t_near_point)
  184.     )
  185.   )
  186.   ;;因为弧线段要加顶点,需要注意的地方较多,建议手工处理
  187.   (if (= (vla-getbulge tx_ent t_param_near) 0.0)
  188.     (princ)
  189.     (progn
  190.       (princ "\n这是弧线段,建议手工处理,程序退出")
  191.       (exit)
  192.     )
  193.   )
  194.   (if (< t_param_near 1)
  195.     (princ)
  196.     (progn (if (= (vla-getbulge tx_ent (1- t_param_near)) 0.0)
  197.         (princ)
  198.         (progn
  199.           (princ "\n这是弧线段,建议手工处理,程序退出")
  200.           (exit)
  201.         )
  202.       )
  203.     )
  204.   )
  205.   ;;取得多段线顶点表
  206.   (setq  t_polyline_vertices
  207.     (vlax-safearray->list
  208.       (vlax-variant-value
  209.         (vlax-get-property tx_ent 'Coordinates)
  210.       )
  211.     )
  212.   )
  213.   ;;计算多段线顶点的数量
  214.   (setq t_polyline_vertices_num (/ (length t_polyline_vertices) 2))
  215.   ;;记录多段线凸度值表
  216.   (setq t_polyline_bulges (list))
  217.   (setq t_1 0)
  218.   (repeat t_polyline_vertices_num
  219.     (setq t_polyline_bulges
  220.       (cons (vla-getbulge tx_ent t_1)
  221.         t_polyline_bulges
  222.       )
  223.     )
  224.     (setq t_1 (1+ t_1))
  225.   )
  226.   (setq t_polyline_bulges (reverse t_polyline_bulges))
  227.   ;;在点表删除点
  228.   (cond
  229.     ;;检测到第一点,起点删除点,表头删除点
  230.     ((= t_param_near 0)
  231.       (setq t_polyline_vertices
  232.         (cdr t_polyline_vertices)
  233.       )
  234.       (setq t_polyline_vertices
  235.         (cdr t_polyline_vertices)
  236.       )
  237.     )
  238.     ;;检测到终点,终点删除点,表尾删除点
  239.     ((= t_param_near (1- t_polyline_vertices_num))
  240.       (setq t_polyline_vertices (reverse t_polyline_vertices))
  241.       (setq t_polyline_vertices
  242.         (cdr t_polyline_vertices)
  243.       )
  244.       (setq t_polyline_vertices
  245.         (cdr t_polyline_vertices)
  246.       )
  247.       (setq t_polyline_vertices (reverse t_polyline_vertices))
  248.     )
  249.     ;;其他则在多段线线段中间删点,表中间删点
  250.     (t
  251.       (progn
  252.         (setq t_polyline_vertices
  253.           (LM:RemoveNth
  254.             (+ (* 2 t_param_near) 0)
  255.             t_polyline_vertices
  256.           )
  257.         )
  258.         (setq t_polyline_vertices
  259.           (LM:RemoveNth
  260.             (+ (* 2 t_param_near) 0)
  261.             t_polyline_vertices
  262.           )
  263.         )
  264.       )
  265.     )
  266.   )
  267.   ;;凸度表删凸度
  268.   (setq  t_polyline_bulges
  269.     (LM:RemoveNth t_param_line t_polyline_bulges)
  270.   )
  271.   ;;将多段线顶点表转换为vlisp能处理数据表
  272.   (setq  t_vla_vertices
  273.     (vlax-make-safearray
  274.       vlax-vbDouble
  275.       (cons 0 (1- (length t_polyline_vertices)))
  276.     )
  277.   )
  278.   (vlax-safearray-fill t_vla_vertices t_polyline_vertices)
  279.   ;;更新多段线顶点
  280.   (vlax-put-property tx_ent 'Coordinates t_vla_vertices)
  281.   ;;更新多段线凸度
  282.   (setq t_1 0)
  283.   (repeat (length t_polyline_bulges)
  284.     (vla-setbulge
  285.       tx_ent
  286.       t_1
  287.       (nth t_1 t_polyline_bulges)
  288.     )
  289.     (setq t_1 (1+ t_1))
  290.   )
  291.   (princ)
  292. )
  293. ;;自编函数,在列表中插入元素
  294. ;;自编函数,在列表中插入元素
  295. ;;自编函数,在列表中插入元素
  296. (defun br:insertnth (t_list  t_n     t_new      /
  297.     t_1  t_list_1   t_list_2   t_list_new
  298.     t_list_num
  299.   )
  300.   (setq t_n (fix t_n))
  301.   (setq t_list_num (length t_list))
  302.   (setq t_list_new (list t_new))
  303.   (cond  ((= t_n 0)
  304.       (setq t_list (append t_list_new t_list))
  305.     )
  306.     ((= t_n t_list_num)
  307.       (setq t_list (append t_list t_list_new))
  308.     )
  309.     ((> t_n t_list_num) (print "[error](br:insertnth) n > length"))
  310.     (t
  311.       (progn
  312.         (setq t_list_1 (list))
  313.         (setq t_list_2 (list))
  314.         (setq t_1 (1- t_n))
  315.         (repeat t_n
  316.           (setq t_list_1 (cons (nth t_1 t_list) t_list_1))
  317.           (setq t_1 (1- t_1))
  318.         )
  319.         
  320.         (setq t_1 (1- t_list_num))
  321.         (repeat (- t_list_num t_n)
  322.           (setq t_list_2 (cons (nth t_1 t_list) t_list_2))
  323.           (setq t_1 (1- t_1))
  324.         )
  325.         (setq t_list (append t_list_1 t_list_new t_list_2))
  326.       )
  327.     )
  328.    
  329.   )
  330.   t_list
  331. )

  332. ;;----------------------=={ Remove Nth }==--------------------;;
  333. ;;                                                            ;;
  334. ;;  Removes the item at the nth index in a supplied list      ;;
  335. ;;------------------------------------------------------------;;
  336. ;;  Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com       ;;
  337. ;;------------------------------------------------------------;;
  338. ;;  Arguments:                                                ;;
  339. ;;  n - index of item to remove (zero based)                  ;;
  340. ;;  l - list from which item is to be removed                 ;;
  341. ;;------------------------------------------------------------;;
  342. ;;  Returns:  List with item at index n removed               ;;
  343. ;;------------------------------------------------------------;;

  344. (defun LM:RemoveNth ( n l / i )
  345.   (setq i -1)
  346.   (vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l)
  347. )

  348. (defun t11 (str del / pos lst)
  349.   (while (setq pos (vl-string-search del str))
  350.     (setq lst (cons (substr str 1 pos) lst)
  351.       str (substr str (+ 1 pos (strlen del)))
  352.     )
  353.   )
  354.   (reverse (cons str lst))
  355. )




发表于 2022-6-21 19:35 | 显示全部楼层
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2022 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2022-6-30 15:01 , Processed in 0.218638 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表