[编程交流] 帮助Lisp执行多个

 
(defun c:xfillet (/ pt)
   ; while picking point -----------------------------
   (while (setq pt (getpoint "\nPick internal point: "))
   (command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
       ; store original boundary object
       (setq original_boundary (entlast))
       ; make offset
       (command "_.offset" 10 (entlast) "_non" pt "")
       
       ; explode offset
       (command "_.explode" (entlast))
       ; load selection set
       (setq ss (ssget "_P"))
       
       ;counter
       (setq x 1) 
       
       ;loop for all elements -------------------
       (repeat (sslength ss)
                
           (setq pa (getvar "peditaccept"))
           
           ; convert all segments into polylines -> so fillet works on all elements
           (setvar "peditaccept" 1)
           (command "pedit" ss nil)
           (setvar "peditaccept" pa)
           
           ; copy element onto layer 0
           (command "_.chprop" (entlast) "" "LA" "0" "")
           
           ; change color of element (included just for texting)
           (command "change" (entlast) "" "prop" "color" x "")
           ; ++++++++++++++++++++++++++++++++
           ; ++++++++++++++++++++++++++++++++
           
           ; what I want to accomplish
           
           ; store first element
           if x = 1 then
           store element in el1
           
           ; loop though elements, make fillets bit by bit
           if x >= 2
           make fillet with el1
           store new element as el1
           
           ; ++++++++++++++++++++++++++++++++
           ; ++++++++++++++++++++++++++++++++
           
           (setvar "peditaccept" pa)
           
           ; counter up
           (setq x (+ x 1))
        
        ; _end repeat
        )
        
        ; delete original boundary
        (command "_.erase" original_boundary "")
   ) ; end while
   
   ;(princ)
) ; end

(defun c:xf ( / *error* cm e0 e1 e2 e3 el p1 pe )
   (defun *error* ( msg )
       (if (= 'int (type cm))
           (setvar 'cmdecho cm)
       )
       (if (= 'int (type pe))
           (setvar 'peditaccept pe)
       )
       (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (setq cm (getvar 'cmdecho)
         pe (getvar 'peditaccept)
   )
   (setvar 'cmdecho 0)
   (setvar 'peditaccept 1)
   (while (setq p1 (getpoint "\nPick Internal Point <Exit>: "))
       (setq e0 (entlast)
             el nil
       )
       (command "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")
       (setq e1 (entlast))
       (if (not (eq e0 e1))
           (progn
               (command "_.offset" 10.0 e1 "_non" p1 "")
               (setq e2 (entlast))
               (if (not (eq e1 e2))
                   (progn
                       (command "_.chprop" e2 "" "_LA" "0" "_C" 1 "")
                       (command "_.explode" e2)
                       (setq e3 e2)
                       (while (setq e3 (entnext e3))
                           (setq el (cons e3 el))
                       )
                       (mapcar
                          '(lambda ( a b ) (setvar 'filletrad 10.0) (command "_.fillet" a b))
                           (cons (last el) el)
                           el
                       )
                       (command "_.pedit" "_M")
                       (while (setq e2 (entnext e2))
                           (command e2)
                       )
                       (command "" "_J" "" "")
                   )
                   (alert "Unable to perform offset.")
               )
               (entdel e1)
           )
           (alert "Unable to detect boundary.")
       )
   )
   (setvar 'peditaccept pe)
   (setvar 'cmdecho cm)
   (princ)
)

(defun c:xf ( / *error* cm e0 e1 e2 e3 el p1 pe ) [highlight](vl-load-com)[/highlight]
   (defun *error* ( msg )
       (if (= 'int (type cm))
           (setvar 'cmdecho cm)
       )
       (if (= 'int (type pe))
           (setvar 'peditaccept pe)
       )
       (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (setq cm (getvar 'cmdecho)
         pe (getvar 'peditaccept)
   )
   (setvar 'cmdecho 0)
   (setvar 'peditaccept 1)
   (while (setq p1 (getpoint "\nPick Internal Point <Exit>: "))
       (setq e0 (entlast)
             el nil
       )
       (command "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")
       (setq e1 (entlast))
       (if (not (eq e0 e1))
           (progn
               (command "_.offset" 10.0 e1 "_non" p1 "")
               (setq e2 (entlast))
               (if (not (eq e1 e2))
                   (progn
                       (command "_.chprop" e2 "" "_LA" "0" "_C" 1 "")
                       (command "_.explode" e2)
                       (setq e3 e2)
                       (while (setq e3 (entnext e3))
                           [highlight](setq el (cons (vlax-curve-getpointatparam e3 (+ (vlax-curve-getstartparam e3) (/ (- (vlax-curve-getendparam e3) (vlax-curve-getstartparam e3)) 2.0))) el))[/highlight]
                       )
                       (mapcar
                          '(lambda ( a b ) (setvar 'filletrad 10.0) (command "_.fillet" a b))
                           (cons (last el) el)
                           el
                       )
                       (command "_.pedit" "_M")
                       (while (setq e2 (entnext e2))
                           (command e2)
                       )
                       (command "" "_J" "" "")
                   )
                   (alert "Unable to perform offset.")
               )
               (entdel e1)
           )
           (alert "Unable to detect boundary.")
       )
   )
   (setvar 'peditaccept pe)
   (setvar 'cmdecho cm)
   (princ)
)