半圆 wipeout

baoxiaozhong · 发表于 2016-4-24 01:20:12

本帖最后由 baoxiaozhong 于 2016-4-24 01:21 编辑

;;-------------------=={ Circular Wipeout }==-----------------;;
;; ;;
;; Enables the user to create a circular wipeout with a ;;
;; given center and radius. Works in all UCS & Views. ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
(defun c:cwipe ( / cen rad )
(cond
( (not
(or (member "acwipeout.arx" (arx)) (arxload "acwipeout.arx" nil)
(member "acismui.arx" (arx)) (arxload "acismui.arx" nil) ;; 2013
)
)
(princ "\nUnable to load wipeout arx files.")
)
( (and
(setq cen (getpoint "\nSpecify Center: "))
(setq rad (getdist "\nSpecify Radius: " cen))
)
(LM:CircularWipeout cen rad)
)
)
(princ)
)
;;-------------------=={ Circle to Wipeout }==----------------;;
;; ;;
;; Enables the user to convert a selection of circles to ;;
;; wipeout objects matching the original circle properties. ;;
;; Works with circles constructed in any UCS. ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
(defun c:c2wipe ( / ent enx inc sel wip )
(cond
( (not
(or (member "acwipeout.arx" (arx)) (arxload "acwipeout.arx" nil)
(member "acismui.arx" (arx)) (arxload "acismui.arx" nil) ;; 2013
)
)
(princ "\nUnable to load wipeout arx files.")
)
( (setq sel (ssget "_:L" '((0 . "CIRCLE"))))
(repeat (setq inc (sslength sel))
(setq ent (ssname sel (setq inc (1- inc)))
enx (entget ent)
wip (LM:CircularWipeout (trans (cdr (assoc 10 enx)) ent 1) (cdr (assoc 40 enx)))
)
(if wip
(progn
(entmod (cons (cons -1 wip) (LM:defaultprops (entget wip))))
(entdel ent)
)
)
)
)
)
(princ)
)
;; Default Properties - Lee Mac
;; Returns a list of DXF properties for the supplied DXF data,
;; substituting default values for absent DXF groups
(defun LM:defaultprops ( elist )
(mapcar
(function
(lambda ( pair )
(cond ((assoc (car pair) elist)) ( pair ))
)
)
'(
(008 . "0")
(006 . "BYLAYER")
(039 . 0.0)
(062 . 256)
(048 . 1.0)
(370 . -1)
)
)
)
;; Circular Wipeout - Lee Mac
;; Creates a circular wipeout with the given center (UCS) & radius
(defun LM:CircularWipeout ( cen rad / ang inc lst )
(setq acc 50
inc (/ pi acc 0.5)
ang 0.0
)
(repeat acc
(setq lst (cons (list 14 (* 0.5 (cos ang)) (* 0.5 (sin ang))) lst)
ang (+ ang inc)
)
)
(entmakex
(append
(list
'(000 . "WIPEOUT")
'(100 . "AcDbEntity")
'(100 . "AcDbWipeout")
(cons 10 (trans (mapcar '- cen (list rad rad)) 1 0))
(cons 11 (trans (list (+ rad rad) 0.0) 1 0 t))
(cons 12 (trans (list 0.0 (+ rad rad)) 1 0 t))
'(280 . 1)
'(071 . 2)
)
(cons (last lst) lst)
)
)
)
(princ)

;;-------------------=={ Circular Wipeout }==-----------------;; 
;;                                                            ;; 
;;  Enables the user to create a circular wipeout with a      ;; 
;;  given center and radius. Works in all UCS & Views.        ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ?2013 - www.lee-mac.com       ;; 
;;------------------------------------------------------------;; 
 
(defun c:cwipe ( / cen rad ) 
    (cond 
        (   (not 
                (or (member "acwipeout.arx" (arx)) (arxload "acwipeout.arx" nil) 
                    (member "acismui.arx"   (arx)) (arxload "acismui.arx"   nil) ;; 2013 
                ) 
            ) 
            (princ "\nUnable to load wipeout arx files.") 
        ) 
        (   (and 
                (setq cen (getpoint "\nSpecify Center: ")) 
                (setq rad (getdist  "\nSpecify Radius: " cen)) 
            ) 
            (LM:CircularWipeout cen rad) 
        ) 
    ) 
    (princ) 
) 
 
;;-------------------=={ Circle to Wipeout }==----------------;; 
;;                                                            ;; 
;;  Enables the user to convert a selection of circles to     ;; 
;;  wipeout objects matching the original circle properties.  ;; 
;;  Works with circles constructed in any UCS.                ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ?2013 - www.lee-mac.com       ;; 
;;------------------------------------------------------------;; 
 
(defun c:c2wipe ( / ent enx inc sel wip ) 
    (cond 
        (   (not 
                (or (member "acwipeout.arx" (arx)) (arxload "acwipeout.arx" nil) 
                    (member "acismui.arx"   (arx)) (arxload "acismui.arx"   nil) ;; 2013 
                ) 
            ) 
            (princ "\nUnable to load wipeout arx files.") 
        ) 
        (   (setq sel (ssget "_:L" '((0 . "CIRCLE")))) 
            (repeat (setq inc (sslength sel)) 
                (setq ent (ssname sel (setq inc (1- inc))) 
                      enx (entget ent) 
                      wip (LM:CircularWipeout (trans (cdr (assoc 10 enx)) ent 1) (cdr (assoc 40 enx))) 
                ) 
                (if wip 
                    (progn 
                        (entmod (cons (cons -1 wip) (LM:defaultprops (entget wip)))) 
                        (entdel ent) 
                    ) 
                ) 
            ) 
        ) 
    ) 
    (princ) 
) 
 
;; Default Properties  -  Lee Mac 
;; Returns a list of DXF properties for the supplied DXF data, 
;; substituting default values for absent DXF groups 
 
(defun LM:defaultprops ( elist ) 
    (mapcar 
        (function 
            (lambda ( pair ) 
                (cond ((assoc (car pair) elist)) ( pair )) 
            ) 
        ) 
       '( 
            (008 . "0") 
            (006 . "BYLAYER") 
            (039 . 0.0) 
            (062 . 256) 
            (048 . 1.0) 
            (370 . -1) 
        ) 
    ) 
) 
 
;; Circular Wipeout  -  Lee Mac 
;; Creates a circular wipeout with the given center (UCS) & radius 
 
(defun LM:CircularWipeout ( cen rad / ang inc lst ) 
    (setq acc 50 
          inc (/ pi acc 0.5) 
          ang 0.0 
    ) 
    (repeat acc 
        (setq lst (cons (list 14 (* 0.5 (cos ang)) (* 0.5 (sin ang))) lst) 
              ang (+ ang inc) 
        ) 
    ) 
    (entmakex 
        (append 
            (list 
               '(000 . "WIPEOUT") 
               '(100 . "AcDbEntity") 
               '(100 . "AcDbWipeout") 
                (cons 10 (trans (mapcar '- cen (list rad rad)) 1 0)) 
                (cons 11 (trans (list (+ rad rad) 0.0) 1 0 t)) 
                (cons 12 (trans (list 0.0 (+ rad rad)) 1 0 t)) 
               '(280 . 1) 
               '(071 . 2) 
            ) 
            (cons (last lst) lst) 
        ) 
    ) 
) 
(princ)

上面的代碼是 LEE MAC寫的全圓 WIPEOUT ，但是我只需要半圓WIPEOUT，而且需要設定方向性，也就是可設定是零度、90度、180 度、270度的方向 WIPEOUT，請問要如何修改上面代碼?

账号		自动登录	找回密码
密码			注册

[提问] 半圆 wipeout

浏览过的版块