未测试:
- (defun c:cirec ( / s rec cen )
- (prompt "\nPick rectangle...")
- (setq s (ssget "_+.:E:S" (list '(0 . "LWPOLYLINE") '(90 . 4) '(-4 . "<or") '(70 . 1) '(70 . 129) '(-4 . "or>"))))
- (while (or (not s) (not (vl-every '(lambda ( x ) (= (cdr x) 0.0)) (vl-remove-if-not '(lambda ( x ) (= (car x) 42)) (entget (ssname s 0))))))
- (prompt "\nEmpty sel.set or picked LWPOLYLINE not polygonal - has arced segments... Retry selection pick again...")
- (setq s (ssget "_+.:E:S" (list '(0 . "LWPOLYLINE") '(90 . 4) '(-4 . "<or") '(70 . 1) '(70 . 129) '(-4 . "or>"))))
- )
- (setq rec (ssname s 0))
- (setq cen (trans (list (/ (+ (car (cdr (assoc 10 (entget rec)))) (car (cdr (assoc 10 (cdr (member (assoc 10 (cdr (member (assoc 10 (entget rec)) (entget rec)))) (entget rec))))))) 2.0) (/ (+ (cadr (cdr (assoc 10 (entget rec)))) (cadr (cdr (assoc 10 (cdr (member (assoc 10 (cdr (member (assoc 10 (entget rec)) (entget rec)))) (entget rec))))))) 2.0) (cdr (assoc 38 (entget rec)))) rec 0))
- (entmake
- (list
- '(0 . "CIRCLE")
- '(100 . "AcDbEntity")
- '(100 . "AcDbCircle")
- (cons 8 "YourLayer") ;; <- change
- (cons 10 (trans cen 0 rec))
- (cons 40 10.0) ;; <- change radius you want
- '(62 . 1) ;; <- change color from red to what you want or remove this line
- (assoc 210 (entget rec))
- )
- )
- (princ)
- )
|