将各种线型反向——多选版

小毛草

(defun C:FS (/ ss i ent ENT1 Q Q2 cp r os)
  (prompt "\n将各种线型反向——多选版")
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)

  ;; 多选对象
  (if (setq ss (ssget '((0 . "LINE,ARC,CIRCLE,LWPOLYLINE,SPLINE"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i)))
              ENT1 ent
              ENT (entget ENT1))

        (cond
          ;;━━━━━━ 多段线处理 ━━━━━━
          ((= (cdr (assoc 0 ENT)) "LWPOLYLINE")
           (reverseLwp ENT1))

          ;;━━━━━━ 直线处理 ━━━━━━
          ((= (cdr (assoc 0 ENT)) "LINE")
           (setq Q (cons 10 (cdr (assoc 11 ENT)))
                 Q2 (cons 11 (cdr (assoc 10 ENT))))
           (entmod (subst Q2 (assoc 11 ENT) (subst Q (assoc 10 ENT) ENT)))
          )

          ;;━━━━━━ 样条曲线处理 ━━━━━━
          ((= (cdr (assoc 0 ENT)) "SPLINE")
           (command "SPLINEDIT" ENT1 "E" "")
           (command "")
          )

          ;;━━━━━━ 圆弧处理 ━━━━━━
          ((= (cdr (assoc 0 ENT)) "ARC")
           (command "pedit" ENT1 "y" "")
           (reverseLwp (entlast))
           (entdel ENT1)
          )

          ;;━━━━━━ 圆处理 ━━━━━━
          ((= (cdr (assoc 0 ENT)) "CIRCLE")
           (setq cp (cdr (assoc 10 ENT))
                 r (cdr (assoc 40 ENT)))
           (entmake
             (list
               '(0 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(67 . 0)
               '(410 . "Model")
               '(100 . "AcDbPolyline")
               '(90 . 2)
               '(70 . 129)
               (cons 10 (polar cp 0 r))
               '(40 . 0)
               '(41 . 0)
               '(42 . -1)
               (cons 10 (polar cp pi r))
               '(40 . 0)
               '(41 . 0)
               '(42 . -1)
             )
           )
           (command "_matchprop" ENT1 (entlast) "")
           (entdel ENT1)
          )
        )
      )
    )
    (prompt "\n未选择有效对象")
  )

  (setvar "osmode" os)
  (princ)
)

;;;=======================================
;;; 多段线反转子程序（保持不变）
;;;=======================================
(defun reverseLwp (ent1 / a pl how li1 li2 li3)
  (setq pl (entget ent1 '("*")) how nil)
  (foreach an pl
    (if (setq a (member (car an) '(10 40 41 42)))
      (setq how t))
    (cond
      ((not how)
       (setq li1 (cons an li1)))
      ((and how a)
       (cond
         ((= (car an) 40) (setq an (cons 41 (cdr an))))
         ((= (car an) 41) (setq an (cons 40 (cdr an))))
         ((= (car an) 42) (setq an (cons 42 (- 0 (cdr an)))))
         (t an)
       )
       (setq li2 (cons an li2))
      )
      ((and how (not a))
       (setq li3 (cons an li3)))
    )
  )
  (entmod (append (reverse li1)
                  (append (cdddr li2) (list (car li2) (cadr li2) (caddr li2)))
                  (reverse li3)))
)

xyp1964

qazxswk 发表于 2025-3-9 05:11
这个依然不起作用。

1. (defun c:tt ()
   
2.   (while (setq e (car (entsel "\n选择圆弧<退出>: ")))
   
3.     (cond ((= (cdr (assoc 0 (entget e))) "ARC")
   
4.            ;(xyp-Put-Mark (vlax-curve-getStartPoint e) 1 0)
   
5.            (setvar "PEDITACCEPT" 1)
   
6.            (command "pedit" e "")
   
7.            (setq e (entlast))
   
8.            (command "pedit" e "r" "")
   
9.            ;(xyp-Put-Mark (vlax-curve-getStartPoint e) 2 0)
   
10.           )
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )

(defun c:tt ()<br />   (while (setq e (car (entsel "\n选择圆弧<退出>: ")))<br />     (cond ((= (cdr (assoc 0 (entget e))) "ARC")<br />            ;(xyp-Put-Mark (vlax-curve-getStartPoint e) 1 0)<br />            (setvar "PEDITACCEPT" 1)<br />            (command "pedit" e "")<br />            (setq e (entlast))<br />            (command "pedit" e "r" "")<br />            ;(xyp-Put-Mark (vlax-curve-getStartPoint e) 2 0)<br />           )<br />     )<br />   )<br />   (princ)<br /> )

xyp1964

小毛草 发表于 2025-3-8 21:56
;;━━━━━━ 圆弧处理 ━━━━━━
          ((= (cdr (assoc 0 ENT)) "ARC")
           (comm ...

1. ((= (cdr (assoc 0 (entget e))) "ARC")
   
2.   (setvar "PEDITACCEPT" 1)
   
3.   (command "pedit" e "")
   
4.   (setq e (entlast))
   
5.   (command "pedit" e "r" "")
   
6. )

((= (cdr (assoc 0 (entget e))) "ARC")<br />   (setvar "PEDITACCEPT" 1)<br />   (command "pedit" e "")<br />   (setq e (entlast))<br />   (command "pedit" e "r" "")<br /> )

小毛草

xyp1964 发表于 2025-3-8 20:16

  ;;━━━━━━ 圆弧处理 ━━━━━━
          ((= (cdr (assoc 0 ENT)) "ARC")
           (command "pedit" ENT1 "y" "")
           (reverseLwp (entlast))
           (entdel ENT1)
          )
这个不起作用，请教版主！谢谢

qazxswk

我也写过这个功能，目前对圆弧不起作用。试了你这个，也是一样。

xyp1964

1. ;多段线反向
   
2. (command "pedit" e "r" "")

;多段线反向<br /> (command "pedit" e "r" "")

qazxswk

xyp1964 发表于 2025-3-8 23:08

这个依然不起作用。

小毛草

试了，的确不行！
((= (cdr (assoc 0 (entget e))) "ARC")
  (setvar "PEDITACCEPT" 1)
  (command "pedit" e "")
  (setq e (entlast))
  (command "pedit" e "r" "")
)

qazxswk

我试用了DS，也没有帮我解决这个问题。

qazxswk

xyp1964 发表于 2025-3-9 12:15

你试试把这文件中的线型反向，如果反向成功，文字会调方向的。