明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 793|回复: 8

批量多段线反向

[复制链接]
发表于 2020-12-11 18:56 | 显示全部楼层 |阅读模式
2明经币
本帖最后由 GDFGFGF 于 2020-12-25 10:58 编辑

已解决

发表于 2020-12-12 23:22 | 显示全部楼层


  1. (defun *error* ( info / )
  2.   (princ)
  3.   )

  4. (defun loc:poly-area (points / ;;;;{{{
  5.                              nexts ) ;;;取得由顺序点构成的多边形的面积
  6.   (if (not
  7.         (apply 'and
  8.                (mapcar '=
  9.                        (car points)
  10.                        (car (reverse points))
  11.                        )
  12.                )
  13.         )
  14.     (setq points (cons (car (reverse points)) points))
  15.     )
  16.   (setq nexts (cdr points))
  17.   (/ (apply '+ (mapcar
  18.                  '(lambda (a b)
  19.                     (- (* (car a) (cadr b))
  20.                        (* (car b) (cadr a))
  21.                        )
  22.                     )
  23.                  points
  24.                  nexts
  25.                  )
  26.             )
  27.      2)
  28.   ) ;;;;}}}

  29. (defun loc:curve-area ( curve-ent / ;{{{
  30.                 loc:range obj points point p-num coord
  31.                 a b c d)

  32.   (defun loc:range ( i / k j)
  33.     (setq k -1)
  34.     (setq j '())
  35.     (repeat i
  36.             (setq k (1+ k))
  37.             (setq j (cons k j))
  38.             )
  39.     (reverse j)
  40.     )

  41.   (setq obj (vlax-ename->vla-object curve-ent))
  42.   (setq points (vla-get-coordinates obj))
  43.   (setq points (vlax-safearray->list
  44.                  (vlax-variant-value points)
  45.                  )
  46.         )
  47.   (setq point (vla-get-coordinate obj 0))
  48.   (setq point (vlax-safearray->list
  49.                 (vlax-variant-value point)
  50.                 )
  51.         )
  52.   (setq p-num (/ (length points) (length point)))
  53.   (setq p-num (loc:range p-num))
  54.   (setq coord
  55.         (mapcar
  56.           '(lambda (a b)
  57.              (list (nth a points) (nth b points))
  58.              )
  59.           (mapcar
  60.             '(lambda (c)
  61.                (* c (length point))
  62.                )
  63.             p-num
  64.             )
  65.           (mapcar
  66.             '(lambda (d)
  67.                (1+
  68.                 (* d (length point))
  69.                 )
  70.                )
  71.             p-num
  72.             )
  73.           )
  74.         )
  75.   (loc:poly-area coord)
  76.   );}}}

  77. (defun loc:reverse-curve ( curve-ent / ;;;;{{{
  78.                 loc:range obj points point p-num coord
  79.                 a b c d)

  80.   (defun loc:range ( i / k j)
  81.     (setq k -1)
  82.     (setq j '())
  83.     (repeat i
  84.             (setq k (1+ k))
  85.             (setq j (cons k j))
  86.             )
  87.     (reverse j)
  88.     )

  89.   (setq obj (vlax-ename->vla-object curve-ent))
  90.   (setq points (vla-get-coordinates obj))
  91.   (setq points (vlax-safearray->list
  92.                  (vlax-variant-value points)
  93.                  )
  94.         )
  95.   (setq point (vla-get-coordinate obj 0))
  96.   (setq point (vlax-safearray->list
  97.                 (vlax-variant-value point)
  98.                 )
  99.         )
  100.   (if ( > (length point) 2)
  101.     (progn
  102.       (princ "输入的多线不是平面多线,退出...")
  103.       (exit)
  104.       )
  105.     )
  106.   (setq p-num (/ (length points) (length point)))
  107.   (setq p-num (loc:range p-num))
  108.   (setq coord
  109.         (mapcar
  110.           '(lambda (a b)
  111.              (list (nth a points) (nth b points))
  112.              )
  113.           (mapcar
  114.             '(lambda (c)
  115.                (* c (length point))
  116.                )
  117.             p-num
  118.             )
  119.           (mapcar
  120.             '(lambda (d)
  121.                (1+
  122.                 (* d (length point))
  123.                 )
  124.                )
  125.             p-num
  126.             )
  127.           )
  128.         )
  129.   (setq coord (reverse coord))
  130.   (setq coord (apply 'append coord))
  131.   (setq coord (vlax-make-variant
  132.                 (vlax-safearray-fill
  133.                   (vlax-make-safearray
  134.                     vlax-vbDouble
  135.                     (cons 0 (1- (length coord)))
  136.                     )
  137.                   coord
  138.                   )
  139.                 )
  140.         )
  141.   (vla-put-coordinates obj coord)
  142.   (princ)
  143.   ) ;;;;}}}

  144. (defun c:tt (  / ;;;;{{{
  145.               ent obj
  146.               )
  147.   (vl-load-com)
  148.   (princ "\n请选择曲线:")
  149.   (and
  150.     (setq ent (car (entsel)))
  151.     (setq obj (vlax-ename->vla-object ent))
  152.     (eq "AcDbPolyline" (vla-get-objectname obj))
  153.     (> (loc:curve-area ent) 0) ;;;改成小于号就是逆时针
  154.     (loc:reverse-curve ent)
  155.     )
  156.   ) ;;;;}}}



图纸打不开,没测试
回复

使用道具 举报

 楼主| 发表于 2020-12-13 11:46 | 显示全部楼层
yarp 发表于 2020-12-12 23:22
图纸打不开,没测试

好的谢谢图纸重发 了

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

 楼主| 发表于 2020-12-13 11:54 | 显示全部楼层
yarp 发表于 2020-12-12 23:22
图纸打不开,没测试

改程序只能单选,要能框选最好,其次我要的是图片左边混乱的起点终点排序通过程序批量改为图片右边统一的顺序。虽然没达到想要的结果,不过也要谢谢你的热心肠
回复

使用道具 举报

发表于 2020-12-14 11:55 | 显示全部楼层
有时间给你升级来转一转。
回复

使用道具 举报

发表于 2020-12-25 09:03 | 显示全部楼层
楼上,在等你的lisp啊
回复

使用道具 举报

发表于 2021-1-4 23:30 | 显示全部楼层
bai2000 发表于 2020-12-25 09:03
楼上,在等你的lisp啊
  1. (defun *error* ( info / )
  2.    (princ)
  3.    )

  4. (defun loc:poly-area (points / ;;;;{{{
  5.                               nexts ) ;;;取得由顺序点构成的多边形的面积
  6.   (if (not
  7.          (apply 'and
  8.                 (mapcar '=
  9.                         (car points)
  10.                         (car (reverse points))
  11.                         )
  12.                 )
  13.          )
  14.      (setq points (cons (car (reverse points)) points))
  15.      )
  16.    (setq nexts (cdr points))
  17.    (/ (apply '+ (mapcar
  18.                   '(lambda (a b)
  19.                      (- (* (car a) (cadr b))
  20.                         (* (car b) (cadr a))
  21.                         )
  22.                      )
  23.                   points
  24.                   nexts
  25.                   )
  26.              )
  27.       2)
  28.    ) ;;;;}}}

  29. (defun loc:curve-area ( curve-ent / ;{{{
  30.                  loc:range obj points point p-num coord
  31.                  a b c d)

  32.    (defun loc:range ( i / k j)
  33.      (setq k -1)
  34.      (setq j '())
  35.      (repeat i
  36.              (setq k (1+ k))
  37.              (setq j (cons k j))
  38.              )
  39.      (reverse j)
  40.      )

  41.    (setq obj (vlax-ename->vla-object curve-ent))
  42.    (setq points (vla-get-coordinates obj))
  43.    (setq points (vlax-safearray->list
  44.                   (vlax-variant-value points)
  45.                   )
  46.          )
  47.    (setq point (vla-get-coordinate obj 0))
  48.    (setq point (vlax-safearray->list
  49.                  (vlax-variant-value point)
  50.                  )
  51.          )
  52.    (setq p-num (/ (length points) (length point)))
  53.    (setq p-num (loc:range p-num))
  54.    (setq coord
  55.          (mapcar
  56.            '(lambda (a b)
  57.               (list (nth a points) (nth b points))
  58.               )
  59.            (mapcar
  60.              '(lambda (c)
  61.                 (* c (length point))
  62.                 )
  63.              p-num
  64.              )
  65.            (mapcar
  66.              '(lambda (d)
  67.                 (1+
  68.                  (* d (length point))
  69.                  )
  70.                 )
  71.              p-num
  72.              )
  73.            )
  74.          )
  75.    (loc:poly-area coord)
  76.    );}}}

  77. (defun loc:reverse-curve ( curve-ent dir corner-func / ;;;;{{{
  78.                  loc:range obj points point p-num coord
  79.                  a b c d)

  80.    (defun loc:range ( i / k j)
  81.      (setq k -1)
  82.      (setq j '())
  83.      (repeat i
  84.              (setq k (1+ k))
  85.              (setq j (cons k j))
  86.              )
  87.      (reverse j)
  88.      )

  89.    (setq obj (vlax-ename->vla-object curve-ent))
  90.    (setq points (vla-get-coordinates obj))
  91.    (setq points (vlax-safearray->list
  92.                   (vlax-variant-value points)
  93.                   )
  94.          )
  95.    (setq point (vla-get-coordinate obj 0))
  96.    (setq point (vlax-safearray->list
  97.                  (vlax-variant-value point)
  98.                  )
  99.          )
  100.    (if ( > (length point) 2)
  101.      (progn
  102.        (princ "输入的多线不是平面多线,退出...")
  103.        (exit)
  104.        )
  105.      )
  106.    (setq p-num (/ (length points) (length point)))
  107.    (setq p-num (loc:range p-num))
  108.    (setq coord
  109.          (mapcar
  110.            '(lambda (a b)
  111.               (list (nth a points) (nth b points))
  112.               )
  113.            (mapcar
  114.              '(lambda (c)
  115.                 (* c (length point))
  116.                 )
  117.              p-num
  118.              )
  119.            (mapcar
  120.              '(lambda (d)
  121.                 (1+
  122.                  (* d (length point))
  123.                  )
  124.                 )
  125.              p-num
  126.              )
  127.            )
  128.          )
  129.    (if dir
  130.    (setq coord (reverse coord))
  131.      )
  132.    (setq coord (loc:rotate-point coord corner-func))
  133.    (setq coord (apply 'append coord))
  134.    (setq coord (vlax-make-variant
  135.                  (vlax-safearray-fill
  136.                    (vlax-make-safearray
  137.                      vlax-vbDouble
  138.                      (cons 0 (1- (length coord)))
  139.                      )
  140.                    coord
  141.                    )
  142.                  )
  143.          )
  144.    
  145.    (vla-put-coordinates obj coord)
  146.    (princ)
  147.    ) ;;;;}}}

  148. (defun c:tt (  / ;;;;{{{
  149.                ent obj
  150.                )
  151.    (vl-load-com)
  152.    (initget 1 "lu ld ru rd")
  153.    (setq kwd (getkword "请输入线段起点在那个角 lu ld ru rd"))
  154.    (setq func-list (mapcar 'cons (list "lu" "ld" "ru" "rd")
  155.                            (list loc:lu loc:ld loc:ru loc:rd)
  156.                            ))
  157.    (setq coner-func (cdr (assoc kwd func-list)))
  158.    (princ "\n请选择曲线:")
  159.    (and
  160.      (setq ent (car (entsel)))
  161.      (setq obj (vlax-ename->vla-object ent))
  162.      (eq "AcDbPolyline" (vla-get-objectname obj))
  163.      (if (> (loc:curve-area ent) 0) ;;;改成小于号就是逆时针
  164.     (loc:reverse-curve ent t coner-func)
  165.        (loc:reverse-curve ent nil coner-func)
  166.        )
  167.      )
  168.    ) ;;;;}}}

  169. (defun loc:lu ( pt / ;{{{
  170.                    )
  171.   (* (- 0 (car pt)) (cadr pt))
  172.   );}}}

  173. (defun loc:ru ( pt /;{{{
  174.                    )
  175.   (* (car pt) (cadr pt))
  176.   );}}}

  177. (defun loc:ld ( pt / ;{{{
  178.                    )
  179.   (* (- 0 (car pt)) (- 0 (cadr pt)))
  180.   );}}}

  181. (defun loc:rd ( pt / ;{{{
  182.                    )
  183.   (* (car pt) (- 0 (cadr pt)))
  184.   );}}}

  185. (defun loc:rotate-point ( pts meth / ;{{{
  186.                              )
  187.   (setq corner-value (apply 'max (mapcar 'meth pts)))
  188.   (setq mark nil)
  189.   (mapcar
  190.     (function (lambda (a)
  191.                 (if (and (/= (meth a) corner-value) (not mark))
  192.                   (progn
  193.                     (setq pts (append (cdr pts) (list (car pts))))
  194.                     )
  195.                   (progn
  196.                     (setq mark t)
  197.                     )
  198.                   )
  199.                 )
  200.               )
  201.     pts)
  202.   pts
  203.   );}}}




可能有点bug, 有问题自行调试哈。
回复

使用道具 举报

发表于 2021-1-5 12:52 | 显示全部楼层
不能框选
回复

使用道具 举报

 楼主| 发表于 2021-1-5 17:15 | 显示全部楼层
批量改变多段线的起点和终点 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!  http://bbs.mjtd.com/thread-182796-1-1.html
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 17:09 , Processed in 0.282397 second(s), 20 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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