社区 › Auto Lisp › 一个简单的程序需要修改。

andy_lee 发表于 2022-7-5 23:07:13

一个简单的程序需要修改。

(defun C:test (/ E LST LST1 N PTS SS X)
(cond
   ((setq ss (ssget ":S" '((0 . "*LINE,ARC"))))
    (repeat (setq n (sslength ss))
      (setq e (ssname ss (setq n (1- n))))
      (setq pts (cons (vlax-curve-getStartPoint e) pts))
      (setq pts (cons (vlax-curve-getEndPoint e) pts))
    )
    (while (setq x (car pts))
      (setq pts (cdr pts))
      (setq lst1 nil
            lstnil
      )
      (foreach      Y pts
      (cond ((equal x Y 0.1) (setq lst (cons Y lst)))
            (T (setq lst1 (cons Y lst1)))
      )
      )
      (cond ((not lst) (command "_.circle" x 5)))
      (setq pts lst1)
    )
   )
)
)
 
 
 
将圆圈颜色更改为红色，并高亮显示红色圆圈。
顺便说一句，一个封闭的数字，不必画圆。仅适用于已关闭的支票。
 
可以修改为椭圆弧吗？

Tharwat 发表于 2022-7-5 23:19:24

(defun c:test (/ d s n e )
(if (setq d (ssadd) s (ssget "_:S" '((0 . "*LINE,ARC"))))
    (repeat (setq n (sslength s))
      (setq e (ssname s (setq n (1- n))))
      (foreach p (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
      (setq d (ssadd (entmakex (list '(0 . "CIRCLE") (cons 10 p) (cons 40 4.) '(62 . 1))) d))
      ))
   )
(sssetfirst nil d)
(princ)
)
   

Tharwat 发表于 2022-7-5 23:30:37

 
这是否意味着要高亮显示绘制的圆？

andy_lee 发表于 2022-7-5 23:42:17

 
对谢谢

Tharwat 发表于 2022-7-5 23:52:00

 
好的，我修改了上面的代码，试试看，然后告诉我。
 
删除第#3条中引用的代码

andy_lee 发表于 2022-7-5 23:54:19

 
好啊好的但“椭圆弧”不受支持。

Tharwat 发表于 2022-7-6 00:04:03

(defun c:test (/ _c d s n e l)
;;    Tharwat 03.May.2014      ;;
(defun _c (e)
   (foreach p (list (vlax-curve-getStartPoint e)
                  (vlax-curve-getEndPoint e)
            )
   (setq d (ssadd (entmakex (list '(0 . "CIRCLE")
                                    (cons 10 p)
                                    (cons 40 4.)
                                    '(62 . 1)
                              )
                  )
                  d
             )
   )
   )
)
(if (setq d (ssadd)
         s (ssget "_:S" '((0 . "*LINE,ARC,ELLIPSE")))
   )
   (repeat (setq n (sslength s))
   (setq e (ssname s (setq n (1- n))))
   (if (eq (cdr (assoc 0 (entget e))) "ELLIPSE")
       (if (not (vlax-curve-isclosed (vlax-ename->vla-object e)))
         (_c e)
       )
       (_c e)
   )
   )
)
(sssetfirst nil d)
(princ)
)

查看完整版本: 一个简单的程序需要修改。