批量多段线反向

GDFGFGF · 发表于 2020-12-11 18:56:26

本帖最后由 GDFGFGF 于 2020-12-25 10:58 编辑

已解决

yarp · 发表于 2020-12-12 23:22:26

(defun *error* ( info / )
(princ)
)
(defun loc:poly-area (points / ;;;;{{{
nexts ) ;;;取得由顺序点构成的多边形的面积
(if (not
(apply 'and
(mapcar '=
(car points)
(car (reverse points))
)
)
)
(setq points (cons (car (reverse points)) points))
)
(setq nexts (cdr points))
(/ (apply '+ (mapcar
'(lambda (a b)
(- (* (car a) (cadr b))
(* (car b) (cadr a))
)
)
points
nexts
)
)
2)
) ;;;;}}}
(defun loc:curve-area ( curve-ent / ;{{{
loc:range obj points point p-num coord
a b c d)
(defun loc:range ( i / k j)
(setq k -1)
(setq j '())
(repeat i
(setq k (1+ k))
(setq j (cons k j))
)
(reverse j)
)
(setq obj (vlax-ename->vla-object curve-ent))
(setq points (vla-get-coordinates obj))
(setq points (vlax-safearray->list
(vlax-variant-value points)
)
)
(setq point (vla-get-coordinate obj 0))
(setq point (vlax-safearray->list
(vlax-variant-value point)
)
)
(setq p-num (/ (length points) (length point)))
(setq p-num (loc:range p-num))
(setq coord
(mapcar
'(lambda (a b)
(list (nth a points) (nth b points))
)
(mapcar
'(lambda (c)
(* c (length point))
)
p-num
)
(mapcar
'(lambda (d)
(1+
(* d (length point))
)
)
p-num
)
)
)
(loc:poly-area coord)
);}}}
(defun loc:reverse-curve ( curve-ent / ;;;;{{{
loc:range obj points point p-num coord
a b c d)
(defun loc:range ( i / k j)
(setq k -1)
(setq j '())
(repeat i
(setq k (1+ k))
(setq j (cons k j))
)
(reverse j)
)
(setq obj (vlax-ename->vla-object curve-ent))
(setq points (vla-get-coordinates obj))
(setq points (vlax-safearray->list
(vlax-variant-value points)
)
)
(setq point (vla-get-coordinate obj 0))
(setq point (vlax-safearray->list
(vlax-variant-value point)
)
)
(if ( > (length point) 2)
(progn
(princ "输入的多线不是平面多线，退出...")
(exit)
)
)
(setq p-num (/ (length points) (length point)))
(setq p-num (loc:range p-num))
(setq coord
(mapcar
'(lambda (a b)
(list (nth a points) (nth b points))
)
(mapcar
'(lambda (c)
(* c (length point))
)
p-num
)
(mapcar
'(lambda (d)
(1+
(* d (length point))
)
)
p-num
)
)
)
(setq coord (reverse coord))
(setq coord (apply 'append coord))
(setq coord (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length coord)))
)
coord
)
)
)
(vla-put-coordinates obj coord)
(princ)
) ;;;;}}}
(defun c:tt ( / ;;;;{{{
ent obj
)
(vl-load-com)
(princ "\n请选择曲线:")
(and
(setq ent (car (entsel)))
(setq obj (vlax-ename->vla-object ent))
(eq "AcDbPolyline" (vla-get-objectname obj))
(> (loc:curve-area ent) 0) ;;;改成小于号就是逆时针
(loc:reverse-curve ent)
)
) ;;;;}}}

(defun *error* ( info / ) 
  (princ) 
  ) 
 
(defun loc:poly-area (points / ;;;;{{{ 
                             nexts ) ;;;取得由顺序点构成的多边形的面积 
  (if (not 
        (apply 'and 
               (mapcar '= 
                       (car points) 
                       (car (reverse points)) 
                       ) 
               ) 
        ) 
    (setq points (cons (car (reverse points)) points)) 
    ) 
  (setq nexts (cdr points)) 
  (/ (apply '+ (mapcar 
                 '(lambda (a b) 
                    (- (* (car a) (cadr b)) 
                       (* (car b) (cadr a)) 
                       ) 
                    ) 
                 points 
                 nexts 
                 ) 
            ) 
     2) 
  ) ;;;;}}} 
 
(defun loc:curve-area ( curve-ent / ;{{{ 
                loc:range obj points point p-num coord 
                a b c d) 
 
  (defun loc:range ( i / k j) 
    (setq k -1) 
    (setq j '()) 
    (repeat i 
            (setq k (1+ k)) 
            (setq j (cons k j)) 
            ) 
    (reverse j) 
    ) 
 
  (setq obj (vlax-ename->vla-object curve-ent)) 
  (setq points (vla-get-coordinates obj)) 
  (setq points (vlax-safearray->list 
                 (vlax-variant-value points) 
                 ) 
        ) 
  (setq point (vla-get-coordinate obj 0)) 
  (setq point (vlax-safearray->list 
                (vlax-variant-value point) 
                ) 
        ) 
  (setq p-num (/ (length points) (length point))) 
  (setq p-num (loc:range p-num)) 
  (setq coord 
        (mapcar 
          '(lambda (a b) 
             (list (nth a points) (nth b points)) 
             ) 
          (mapcar 
            '(lambda (c) 
               (* c (length point)) 
               ) 
            p-num 
            ) 
          (mapcar 
            '(lambda (d) 
               (1+ 
                (* d (length point)) 
                ) 
               ) 
            p-num 
            ) 
          ) 
        ) 
  (loc:poly-area coord) 
  );}}} 
 
(defun loc:reverse-curve ( curve-ent / ;;;;{{{ 
                loc:range obj points point p-num coord 
                a b c d) 
 
  (defun loc:range ( i / k j) 
    (setq k -1) 
    (setq j '()) 
    (repeat i 
            (setq k (1+ k)) 
            (setq j (cons k j)) 
            ) 
    (reverse j) 
    ) 
 
  (setq obj (vlax-ename->vla-object curve-ent)) 
  (setq points (vla-get-coordinates obj)) 
  (setq points (vlax-safearray->list 
                 (vlax-variant-value points) 
                 ) 
        ) 
  (setq point (vla-get-coordinate obj 0)) 
  (setq point (vlax-safearray->list 
                (vlax-variant-value point) 
                ) 
        ) 
  (if ( > (length point) 2) 
    (progn 
      (princ "输入的多线不是平面多线，退出...") 
      (exit) 
      ) 
    ) 
  (setq p-num (/ (length points) (length point))) 
  (setq p-num (loc:range p-num)) 
  (setq coord 
        (mapcar 
          '(lambda (a b) 
             (list (nth a points) (nth b points)) 
             ) 
          (mapcar 
            '(lambda (c) 
               (* c (length point)) 
               ) 
            p-num 
            ) 
          (mapcar 
            '(lambda (d) 
               (1+ 
                (* d (length point)) 
                ) 
               ) 
            p-num 
            ) 
          ) 
        ) 
  (setq coord (reverse coord)) 
  (setq coord (apply 'append coord)) 
  (setq coord (vlax-make-variant 
                (vlax-safearray-fill 
                  (vlax-make-safearray 
                    vlax-vbDouble 
                    (cons 0 (1- (length coord))) 
                    ) 
                  coord 
                  ) 
                ) 
        ) 
  (vla-put-coordinates obj coord) 
  (princ) 
  ) ;;;;}}} 
 
(defun c:tt (  / ;;;;{{{ 
              ent obj 
              ) 
  (vl-load-com) 
  (princ "\n请选择曲线:") 
  (and 
    (setq ent (car (entsel))) 
    (setq obj (vlax-ename->vla-object ent)) 
    (eq "AcDbPolyline" (vla-get-objectname obj)) 
    (> (loc:curve-area ent) 0) ;;;改成小于号就是逆时针 
    (loc:reverse-curve ent) 
    ) 
  ) ;;;;}}}

图纸打不开，没测试

GDFGFGF · 发表于 2020-12-13 11:46:26

yarp 发表于 2020-12-12 23:22
图纸打不开，没测试

好的谢谢图纸重发了

GDFGFGF · 发表于 2020-12-13 11:54:45

yarp 发表于 2020-12-12 23:22
图纸打不开，没测试

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

yarp · 发表于 2020-12-14 11:55:11

有时间给你升级来转一转。

bai2000 · 发表于 2020-12-25 09:03:58

楼上，在等你的lisp啊

yarp · 发表于 2021-1-4 23:30:35

bai2000 发表于 2020-12-25 09:03
楼上，在等你的lisp啊

(defun *error* ( info / )
(princ)
)
(defun loc:poly-area (points / ;;;;{{{
nexts ) ;;;取得由顺序点构成的多边形的面积
(if (not
(apply 'and
(mapcar '=
(car points)
(car (reverse points))
)
)
)
(setq points (cons (car (reverse points)) points))
)
(setq nexts (cdr points))
(/ (apply '+ (mapcar
'(lambda (a b)
(- (* (car a) (cadr b))
(* (car b) (cadr a))
)
)
points
nexts
)
)
2)
) ;;;;}}}
(defun loc:curve-area ( curve-ent / ;{{{
loc:range obj points point p-num coord
a b c d)
(defun loc:range ( i / k j)
(setq k -1)
(setq j '())
(repeat i
(setq k (1+ k))
(setq j (cons k j))
)
(reverse j)
)
(setq obj (vlax-ename->vla-object curve-ent))
(setq points (vla-get-coordinates obj))
(setq points (vlax-safearray->list
(vlax-variant-value points)
)
)
(setq point (vla-get-coordinate obj 0))
(setq point (vlax-safearray->list
(vlax-variant-value point)
)
)
(setq p-num (/ (length points) (length point)))
(setq p-num (loc:range p-num))
(setq coord
(mapcar
'(lambda (a b)
(list (nth a points) (nth b points))
)
(mapcar
'(lambda (c)
(* c (length point))
)
p-num
)
(mapcar
'(lambda (d)
(1+
(* d (length point))
)
)
p-num
)
)
)
(loc:poly-area coord)
);}}}
(defun loc:reverse-curve ( curve-ent dir corner-func / ;;;;{{{
loc:range obj points point p-num coord
a b c d)
(defun loc:range ( i / k j)
(setq k -1)
(setq j '())
(repeat i
(setq k (1+ k))
(setq j (cons k j))
)
(reverse j)
)
(setq obj (vlax-ename->vla-object curve-ent))
(setq points (vla-get-coordinates obj))
(setq points (vlax-safearray->list
(vlax-variant-value points)
)
)
(setq point (vla-get-coordinate obj 0))
(setq point (vlax-safearray->list
(vlax-variant-value point)
)
)
(if ( > (length point) 2)
(progn
(princ "输入的多线不是平面多线，退出...")
(exit)
)
)
(setq p-num (/ (length points) (length point)))
(setq p-num (loc:range p-num))
(setq coord
(mapcar
'(lambda (a b)
(list (nth a points) (nth b points))
)
(mapcar
'(lambda (c)
(* c (length point))
)
p-num
)
(mapcar
'(lambda (d)
(1+
(* d (length point))
)
)
p-num
)
)
)
(if dir
(setq coord (reverse coord))
)
(setq coord (loc:rotate-point coord corner-func))
(setq coord (apply 'append coord))
(setq coord (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length coord)))
)
coord
)
)
)
(vla-put-coordinates obj coord)
(princ)
) ;;;;}}}
(defun c:tt ( / ;;;;{{{
ent obj
)
(vl-load-com)
(initget 1 "lu ld ru rd")
(setq kwd (getkword "请输入线段起点在那个角 lu ld ru rd"))
(setq func-list (mapcar 'cons (list "lu" "ld" "ru" "rd")
(list loc:lu loc:ld loc:ru loc:rd)
))
(setq coner-func (cdr (assoc kwd func-list)))
(princ "\n请选择曲线:")
(and
(setq ent (car (entsel)))
(setq obj (vlax-ename->vla-object ent))
(eq "AcDbPolyline" (vla-get-objectname obj))
(if (> (loc:curve-area ent) 0) ;;;改成小于号就是逆时针
(loc:reverse-curve ent t coner-func)
(loc:reverse-curve ent nil coner-func)
)
)
) ;;;;}}}
(defun loc:lu ( pt / ;{{{
)
(* (- 0 (car pt)) (cadr pt))
);}}}
(defun loc:ru ( pt /;{{{
)
(* (car pt) (cadr pt))
);}}}
(defun loc:ld ( pt / ;{{{
)
(* (- 0 (car pt)) (- 0 (cadr pt)))
);}}}
(defun loc:rd ( pt / ;{{{
)
(* (car pt) (- 0 (cadr pt)))
);}}}
(defun loc:rotate-point ( pts meth / ;{{{
)
(setq corner-value (apply 'max (mapcar 'meth pts)))
(setq mark nil)
(mapcar
(function (lambda (a)
(if (and (/= (meth a) corner-value) (not mark))
(progn
(setq pts (append (cdr pts) (list (car pts))))
)
(progn
(setq mark t)
)
)
)
)
pts)
pts
);}}}

(defun *error* ( info / ) 
   (princ) 
   ) 
 
 (defun loc:poly-area (points / ;;;;{{{ 
                              nexts ) ;;;取得由顺序点构成的多边形的面积 
  (if (not 
         (apply 'and 
                (mapcar '= 
                        (car points) 
                        (car (reverse points)) 
                        ) 
                ) 
         ) 
     (setq points (cons (car (reverse points)) points)) 
     ) 
   (setq nexts (cdr points)) 
   (/ (apply '+ (mapcar 
                  '(lambda (a b) 
                     (- (* (car a) (cadr b)) 
                        (* (car b) (cadr a)) 
                        ) 
                     ) 
                  points 
                  nexts 
                  ) 
             ) 
      2) 
   ) ;;;;}}} 
 
 (defun loc:curve-area ( curve-ent / ;{{{ 
                 loc:range obj points point p-num coord 
                 a b c d) 
 
   (defun loc:range ( i / k j) 
     (setq k -1) 
     (setq j '()) 
     (repeat i 
             (setq k (1+ k)) 
             (setq j (cons k j)) 
             ) 
     (reverse j) 
     ) 
 
   (setq obj (vlax-ename->vla-object curve-ent)) 
   (setq points (vla-get-coordinates obj)) 
   (setq points (vlax-safearray->list 
                  (vlax-variant-value points) 
                  ) 
         ) 
   (setq point (vla-get-coordinate obj 0)) 
   (setq point (vlax-safearray->list 
                 (vlax-variant-value point) 
                 ) 
         ) 
   (setq p-num (/ (length points) (length point))) 
   (setq p-num (loc:range p-num)) 
   (setq coord 
         (mapcar 
           '(lambda (a b) 
              (list (nth a points) (nth b points)) 
              ) 
           (mapcar 
             '(lambda (c) 
                (* c (length point)) 
                ) 
             p-num 
             ) 
           (mapcar 
             '(lambda (d) 
                (1+ 
                 (* d (length point)) 
                 ) 
                ) 
             p-num 
             ) 
           ) 
         ) 
   (loc:poly-area coord) 
   );}}} 
 
 (defun loc:reverse-curve ( curve-ent dir corner-func / ;;;;{{{ 
                 loc:range obj points point p-num coord 
                 a b c d) 
 
   (defun loc:range ( i / k j) 
     (setq k -1) 
     (setq j '()) 
     (repeat i 
             (setq k (1+ k)) 
             (setq j (cons k j)) 
             ) 
     (reverse j) 
     ) 
 
   (setq obj (vlax-ename->vla-object curve-ent)) 
   (setq points (vla-get-coordinates obj)) 
   (setq points (vlax-safearray->list 
                  (vlax-variant-value points) 
                  ) 
         ) 
   (setq point (vla-get-coordinate obj 0)) 
   (setq point (vlax-safearray->list 
                 (vlax-variant-value point) 
                 ) 
         ) 
   (if ( > (length point) 2) 
     (progn 
       (princ "输入的多线不是平面多线，退出...") 
       (exit) 
       ) 
     ) 
   (setq p-num (/ (length points) (length point))) 
   (setq p-num (loc:range p-num)) 
   (setq coord 
         (mapcar 
           '(lambda (a b) 
              (list (nth a points) (nth b points)) 
              ) 
           (mapcar 
             '(lambda (c) 
                (* c (length point)) 
                ) 
             p-num 
             ) 
           (mapcar 
             '(lambda (d) 
                (1+ 
                 (* d (length point)) 
                 ) 
                ) 
             p-num 
             ) 
           ) 
         ) 
   (if dir 
   (setq coord (reverse coord)) 
     ) 
   (setq coord (loc:rotate-point coord corner-func)) 
   (setq coord (apply 'append coord)) 
   (setq coord (vlax-make-variant 
                 (vlax-safearray-fill 
                   (vlax-make-safearray 
                     vlax-vbDouble 
                     (cons 0 (1- (length coord))) 
                     ) 
                   coord 
                   ) 
                 ) 
         ) 
    
   (vla-put-coordinates obj coord) 
   (princ) 
   ) ;;;;}}} 
 
 (defun c:tt (  / ;;;;{{{ 
               ent obj 
               ) 
   (vl-load-com) 
   (initget 1 "lu ld ru rd") 
   (setq kwd (getkword "请输入线段起点在那个角 lu ld ru rd")) 
   (setq func-list (mapcar 'cons (list "lu" "ld" "ru" "rd") 
                           (list loc:lu loc:ld loc:ru loc:rd) 
                           )) 
   (setq coner-func (cdr (assoc kwd func-list))) 
   (princ "\n请选择曲线:") 
   (and 
     (setq ent (car (entsel))) 
     (setq obj (vlax-ename->vla-object ent)) 
     (eq "AcDbPolyline" (vla-get-objectname obj)) 
     (if (> (loc:curve-area ent) 0) ;;;改成小于号就是逆时针 
    (loc:reverse-curve ent t coner-func) 
       (loc:reverse-curve ent nil coner-func) 
       ) 
     ) 
   ) ;;;;}}} 
 
(defun loc:lu ( pt / ;{{{ 
                   ) 
  (* (- 0 (car pt)) (cadr pt)) 
  );}}} 
 
(defun loc:ru ( pt /;{{{ 
                   ) 
  (* (car pt) (cadr pt)) 
  );}}} 
 
(defun loc:ld ( pt / ;{{{ 
                   ) 
  (* (- 0 (car pt)) (- 0 (cadr pt))) 
  );}}} 
 
(defun loc:rd ( pt / ;{{{ 
                   ) 
  (* (car pt) (- 0 (cadr pt))) 
  );}}} 
 
(defun loc:rotate-point ( pts meth / ;{{{ 
                             ) 
  (setq corner-value (apply 'max (mapcar 'meth pts))) 
  (setq mark nil) 
  (mapcar 
    (function (lambda (a) 
                (if (and (/= (meth a) corner-value) (not mark)) 
                  (progn 
                    (setq pts (append (cdr pts) (list (car pts)))) 
                    ) 
                  (progn 
                    (setq mark t) 
                    ) 
                  ) 
                ) 
              ) 
    pts) 
  pts 
  );}}}

可能有点bug，有问题自行调试哈。

bai2000 · 发表于 2021-1-5 12:52:44

不能框选

GDFGFGF · 发表于 2021-1-5 17:15:51

批量改变多段线的起点和终点 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz! http://bbs.mjtd.com/thread-182796-1-1.html

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

批量多段线反向

本帖子中包含更多资源

浏览过的版块