小毛草 发表于 2025-3-8 17:26:26

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

(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 发表于 2025-3-9 12:15:06

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




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




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

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

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

小毛草 发表于 2025-3-8 21:56:04

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


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

qazxswk 发表于 2025-3-8 17:58:35

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

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

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

qazxswk 发表于 2025-3-9 05:11:52

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


这个依然不起作用。

小毛草 发表于 2025-3-9 09:49:08

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

qazxswk 发表于 2025-3-9 11:52:21

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

qazxswk 发表于 2025-3-9 12:51:57

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

你试试把这文件中的线型反向，如果反向成功，文字会调方向的。
页: [1] 2
查看完整版本: 将各种线型反向——多选版