社区 › Auto Lisp › 列出样条曲线、椭圆、圆弧。。。

Lee Mac 发表于 2022-7-5 20:24:28

以下是一些帮助您入门的代码：
(defun c:ar ( / e i n s )
   (alert
       (strcat
         (if (setq s (ssget "_X" '((0 . "ELLIPSE"))))
               (strcat "Found " (itoa (sslength s)) " ellipse" (if (= 1 (sslength s)) "." "s."))
               "No ellipses found."
         )
         (if (setq s (ssget "_X" '((0 . "SPLINE"))))
               (strcat "\nFound " (itoa (sslength s)) " spline" (if (= 1 (sslength s)) "." "s."))
               "\nNo splines found."
         )
         (if (setq s (ssget "_X" '((0 . "ARC"))))
               (progn
                   (setq n 0)
                   (repeat (setq i (sslength s))
                     (setq e (entget (ssname s (setq i (1- i)))))
                     (if (< (* (cdr (assoc 40 e)) (rem (+ (- (cdr (assoc 51 e)) (cdr (assoc 50 e))) pi pi) (+ pi pi))) 0.125)
                           (setq n (1+ n))
                     )
                   )
                   (if (< 0 n)
                     (strcat "\nFound " (itoa n) " arc" (if (= 1 n) "" "s") " shorter than 1/8\"")
                     "\nNo arcs shorter than 1/8\" found."
                   )
               )
               "\nNo arcs found."
         )
       )
   )
   (princ)
)

2andygs 发表于 2022-7-5 20:28:52

样条线和椭圆可以是任何大小。。。。。只有小于1/8英寸的圆弧和直线
非常感谢。

2andygs 发表于 2022-7-5 20:31:17

谢谢你，李，太好了。。。正是我想要的。。。

Lee Mac 发表于 2022-7-5 20:34:21

不客气我希望代码是明确的。

2andygs 发表于 2022-7-5 20:38:30

效果很好。。。您还可以添加长度小于1/8”的线条，并将所有选定项目（样条线、椭圆、弧和小于1/8”的线条）移动到图层名称“fix”吗
谢谢

2andygs 发表于 2022-7-5 20:40:08

嗨，李麦克，
 
 
您还可以添加长度小于1/8”的线条，并将所有选定项目（样条线、椭圆、弧和小于1/8”的线条）移动到图层名称“fix”吗
 
 
谢谢

2andygs 发表于 2022-7-5 20:42:47

嗨，李麦克，
 
 
Hi试图修改代码以选择小于1/8”的行…但不起作用…请查看代码
 
 

(defun c:stt ( / e i n s )
   (alert
       (strcat
         (if (setq se (ssget "_X" '((0 . "ELLIPSE"))))
               (strcat "Found" (itoa (sslength se)) "Ellipse" (if (= 1 (sslength se)) "." "s."))
               "\nNo ellipses found."
         )
                     
         (if (setq sp (ssget "_X" '((0 . "SPLINE"))))
               (strcat "\nFound" (itoa (sslength sp)) "Spline" (if (= 1 (sslength sp)) "." "s."))
               "\nNo Splines found."
         )
         (if (setq sl (ssget "_X" '((0 . "LINE"))))
               (strcat "\nFound" (itoa (sslength sl)) "Line" (if (= 1 (sslength sl)) "." "s."))
               "\nNo Lines found."
         )
         (if (setq sa (ssget "_X" '((0 . "ARC"))))
               (progn
                   (setq n 0)
                   (repeat (setq i (sslength sa))
                     (setq e (entget (ssname sa (setq i (1- i)))))
                     (if (< (* (cdr (assoc 40 e)) (rem (+ (- (cdr (assoc 51 e)) (cdr (assoc 50 e))) pi pi) (+ pi pi))) 0.125)
                           (setq n (1+ n))
                     )
                   )
                   (if (< 0 n)
                     (strcat "\nFound" (itoa n) "Arc" (if (= 1 n) "" "s") " shorter than 1/8\"")
                     "\nNo Arcs shorter than 1/8\" found."
                   )
               )
               "\nNo arcs found."            
         
         )
       )
   )
(command "LAYER" "NEW" "FIX" "COLOR" "5" "FIX" "")
(COMMAND "CHANGE" se sp sa sl "" "p""layer" "fix" "")
   (princ)
)

Lee Mac 发表于 2022-7-5 20:47:26

请尝试以下操作：
（defun c:stt（/e i n sa se sl sp）（警报（strcat（if（setq se（ssget“_X”）（（0。“椭圆”）（8。”~固定”）））（strcat“Found”（itoa（sslength se））“椭圆”（if（=1（sslength se）））“s.”）“\n未找到省略号。”）（if（setq sp（ssget“_X”'（（0.“SPLINE”）（8.“FIX”））））（strcat“\n找到”（itoa（sslength sp））“SPLINE”（if（=1（sslength sp））”“s.”）“\n未找到样条线。”）（if（setq sl（ssget“_X”'（（0。“LINE”）（8。”~ FIX”）））（progn（repeat（setq i（sslength sl））（setq e（entget（ssname sl（setq i（1-i ））））））））（if（

2andygs 发表于 2022-7-5 20:49:39

非常感谢李，很好。

2andygs 发表于 2022-7-5 20:53:44

嗨，李，我只是注意到一件事在日常。。。如果您使用该命令两次。。。第二次，它无法识别任何椭圆、样条弧和直线。。。如果我把图层改回“0”，它就会识别。

查看完整版本: 列出样条曲线、椭圆、圆弧。。。