有偿求闭合多段线指定任意点为起点的代码

18989878581

有偿求闭合多段线指定任意点为起点的代码

xj6019

大海老师的函数，自己测试：
;;以指定起点逆时针重新排列多段线 多段线重新指定起点
;;参数1:点表、凸度表((点 凸度)(点 凸度)(点 凸度)……)
;;参数2：起点索引号
;;参数3:是否反向T为反向nil不反
(defun qidiansort (lss nn clock)
(if clock (setq nn (1+ nn)))
(setq lss(try-SortList lss nn))
(if clock
  (setq lss (reverse lss)
   lss(try-SortList(cadr(setq lssx(try-Array-Matrix lss)))1);将凸度倒退一步
   lss(mapcar '- lss)
   lss2(car lssx)
   lss(try-Array-Matrix (list lss2 lss))
  )
)
lss
)

;; 以表内指定序号为首重新排序
;;(try-SortList 任意表 序号(零基)
;;参数：任意表
;; (try-SortList '(1 2 3 4 5 6 7 8 9 10) 4)
;;                →(5 6 7 8 9 10 1 2 3 4)
(defun try-SortList(lst sub / lists n pt_list retun)
(setq lists '())
(setq n (length lst))
(repeat n
  (setq lists(cons (nth sub lst) lists))
  
  (setq sub(1+ sub))
  (if(= sub n)(setq sub 0))
)
(reverse lists)
)

;; SortList 以表内指定序号为首重新排序 (SortList 表 序号(零基))
;; (SortList '(1 2 3 4 5 6 7 8 9 10) 4) → '(5 6 7 8 9 10 1 2 3 4)
(defun SortList (lst sub)
  (setq lst (xyp-List-Div lst sub)
lst (append (cdr lst) (list (car lst)))
lst (apply 'append lst)
  )
)
;;矩阵互换
;(try-Array-one2n'((0 1 2 3 4)(5 6 7 8 9)(a b c d e))))
; <->'((0 5 a)(1 6 b)(2 7 c)(3 8 d)(4 9 e))
(defun try-Array-Matrix(lst)(apply 'mapcar (cons 'list lst)))

hhh454

;;分享，带说明，可以自己研究
;;多段线定制起点
(defun c:tt  (/ e p el el1 pam pam0 pam1 pam2 el2 el3 el4)
  (if (and (setq e (entsel "\n选择底板: "))
           (setq p (getpoint "\n指定起点: "))
      )
    (progn
      (setq el         (entget (car e));_ 取得图元属性
            el1         (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 40 41 42)));_取得表中以10 40 41 42开头的
               (member (assoc 10 el) el);_取得10开头后面的表
                        );_返回由所提供表中的所有能通过测试函数的元素组成的表
            el2         (reverse (cdr (member (assoc 10 el) (reverse el))));_此处为反表，即为10开头前面的表，留着组合新表
            pam         (vlax-curve-getparamatpoint(car e)(vlax-curve-getclosestpointto (car e) p))
                     ;_返回曲线在指定点的参数           ;;返回曲线上离指定点最近的点
                         ;;意思就是找出和指定起点最近的点，然后找出在表中是第几个点，表中排位从0开始
            pam1 (fix pam);_ 起点原来所在表中的第几个
            pam2 (1+ pam1);_ 起点的下一个点
      )
      (if (>= (- pam pam1) 0.5)
              (setq pam0 pam2)
              (setq pam0 pam1)
        );_ near index附近的指数
      (setq p (nth (* 4 pam0) el1));_一组四个(10 40 41 42),所以参数×4
      (setq el3        (append        (member p el1)
                        (reverse (cdr (member p (reverse el1))))
                )
      );_ reset points重置点
      (entmod (append el2 el3))
      )
    )
  (princ)
)

18989878581

xj6019 发表于 2021-9-30 17:26
大海老师的函数，自己测试：
;;以指定起点逆时针重新排列多段线 多段线重新指定起点
;;参数1:点表、凸度 ...

你好   这个函数如何调用