xiao88gang 发表于 2017-10-20 21:40:57

天天做伸手党，今天也发一个“弧变圆”的源码

(defun C:hu (/ CUTALL SS I E ENT)
   (SETVAR "osmode" 0)
(defun CUTALL        (LST ITEM / M)
    (if        (and (LISTP LST) (setq M (MEMBER ITEM LST)))
      (progn (setq LST (REVERSE LST))
             (repeat (LENGTH M) (setq LST (cdr LST)))
             (CUTALL (APPEND (REVERSE LST) (cdr M)) ITEM)
      )
      LST
    )
)
(setq I 0)
(PROMPT "\n框选即将变圆的圆弧：")
(if (setq SS (SSGET '((0 . "ARC"))))
    (repeat (SSLENGTH SS)
      (setq E (SSNAME SS I))
      (setq ENT (ENTGET E))
      (setq ENT (CUTALL ENT '(100 . "AcDbArc")))
      (setq ENT (CUTALL ENT (ASSOC 50 ENT)))
      (setq ENT (CUTALL ENT (ASSOC 51 ENT)))
      (setq ENT (SUBST (cons 0 "CIRCLE") (ASSOC 0 ENT) ENT))
      (setq I (1+ I))
      (ENTDEL E)
      (ENTMAKE ENT)
    )
)
    (PRINC)
)

xyp1964 发表于 2017-10-20 22:33:02

(defun c:tt ()
(princ "\n框选即将变圆的圆弧: ")
(if (setq ss (ssget '((0 . "arc")))
          i-1
      )
    (repeat (sslength ss)
      (setq s1 (ssname ss (setq i (1+ i)))
          en (vl-remove-if-not '(lambda (x) (member (car x) '(6 8 10 40))) (entget s1))
          en (append '((0 . "CIRCLE") (100 . "AcDbEntity") (100 . "AcDbCircle")) en)
      )
      (entmakex en)
      (entdel s1)
    )
)
(princ)
)

q3_2006 发表于 2017-10-21 09:58:21

(command "join" e "L")

ysq101 发表于 2017-10-21 12:12:36

q3_2006 发表于 2017-10-21 09:58
(command "join" e "L")

简单暴力。。。。。。。。。。。。。。

xyp1964 发表于 2017-10-24 12:52:05

;; 看似圆，实际生成的是闭合的多段线
(command "pedit" "m" (ssget '((0 . "arc"))) "y" "c" "")
页: [1]
查看完整版本: 天天做伸手党，今天也发一个“弧变圆”的源码