[LISP函数]：自已写的一个自动修剪双线程序

xiagood

自已写的一个自已修剪程序。
像天正那样墙这间自动修剪。
(Defun c:Tk ()
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setq ints1 nil)  
  (princ "\n请选择梁线:")
  (setq Trimobj (ssget '((0 . "line"))))
  (setq n (sslength Trimobj))
  (cond
    ((or (= n 1) (= n nil)) (princ "\n不能自动剪切！"))
    ((= n 2)
         (progn
               (setq s1 (ssname TrimObj 0))
               (setq s2 (ssname TrimObj 1))
               (setq s1_1 (entget s1))
               (setq s2_1 (entget s2))
               (setq p1 (Inters (cdr (assoc 10 s1_1))
                       (cdr (assoc 11 s1_1))
                       (cdr (assoc 10 s2_1))
                       (cdr (assoc 11 s2_1))
               ))
              (if (= p1 nil)
                  (progn
                      (command "._fillet" "R" "0" "")
                      (command "._fillet" s1 s2)
                   )
                   (progn
                       (if (> (distance (cdr (assoc 10 s1_1)) p1) (distance (cdr (assoc 11 s1_1)) p1))
                           (command "._break" s1  p1 (cdr (assoc 11 s1_1)))
                           (command "._break" s1  p1 (cdr (assoc 10 s1_1)))
                        )
                       (if (> (distance (cdr (assoc 10 s2_1)) p1) (distance (cdr (assoc 11 s2_1)) p1))
                           (command "._break" s2  p1 (cdr (assoc 11 s2_1)))
                           (command "._break" s2  p1 (cdr (assoc 10 s2_1)))
                        )
                     )
                )
           )
        )
       ((= n 3)
            (progn
                (setq L3 nil)
                (setq i 0)
                (setq j 0)
                (setq Obj1 nil)
                (while (< i n)
                       (setq c1 (ssname Trimobj i))
                       (setq c1_1 (entget c1))
                       (setq i_1 (+ i 1))
                       (while (< i_1 n)
                              (setq d1 (ssname Trimobj i_1))
                              (setq d1_1 (entget d1))
                              (setq p2 (Inters (cdr (assoc 10 c1_1))
                                               (cdr (assoc 11 c1_1))
                                               (cdr (assoc 10 d1_1))
                                               (cdr (assoc 11 d1_1))
                                               nil
                               ))
                               (if (/= p2 nil)
                                   (setq L3 (append L3 (list p2)))
                               )
                               (setq i_1 (+ i_1 1))
                         )
                         (if (= (length L3) 2)
                             (setq Obj1 (ssname Trimobj i))
                          )
                         (setq i (+ i 1))
                  )
                  (command "._break" Obj1  (nth 0 L3) (nth 1 L3))
                  (setq Trimobj (ssdel Obj1 Trimobj))
                  (while (< j (sslength TrimObj))
                         (setq e1 (ssname TrimObj j))
                         (setq e1_1 (entget e1))
                         (if (= (+ (distance (cdr (assoc 10 e1_1)) (nth j L3)) (distance (cdr (assoc 11 e1_1)) (nth j L3)))
                                (distance (cdr (assoc 10 e1_1)) (cdr (assoc 11 e1_1))))
                                (if (> (distance (cdr (assoc 10 e1_1)) (nth j L3)) (distance (cdr (assoc 11 e1_1)) (nth j L3)))
                                      (progn
                                           (setq e2 (assoc 11 e1_1))
                                           (setq e2_1 (cdr e2))
                                           (setq e2_new (cons 11 (nth j L3)))
                                           (setq e1_1 (subst e2_new e2 e1_1))
                                           (entmod e1_1)
                                        )
                                        (progn
                                           (setq e2 (assoc 10 e1_1))
                                           (setq e2_1 (cdr e2))
                                           (setq e2_new (cons 10 (nth j L3)))
                                           (setq e1_1 (subst e2_new e2 e1_1))
                                           (entmod e1_1)
                                        )
                                  )
                           )
                         (if (= (distance (cdr (assoc 10 e1_1)) (cdr (assoc 11 e1_1)))
                                 (- (distance (cdr (assoc 10 e1_1)) (nth j L3)) (distance (cdr (assoc 11 e1_1)) (nth j L3)))
                                 Or (- (distance (cdr (assoc 11 e1_1)) (nth j L3)) (distance (cdr (assoc 10 e1_1)) (nth j L3)))
                              )
                                 (if (< (distance (cdr (assoc 10 e1_1)) (nth j L3)) (distance (cdr (assoc 11 e1_1)) (nth j L3)))
                                        (progn
                                           (setq e2 (assoc 11 e1_1))
                                           (setq e2_1 (cdr e2))
                                           (setq e2_new (cons 11 (nth j L3)))
                                           (setq e1 (subst e2_new e2 e1))
                                           (entmod e1)
                                        )
                                        (progn
                                           (setq e2 (assoc 10 e1_1))
                                           (setq e2_1 (cdr e2))
                                           (setq e2_new (cons 10 (nth j L3)))
                                           (setq e1 (subst e2_new e2 e1))
                                           (entmod e1)
                                        )
                                   )
                         )
                        (setq j (+ j 1))
                    )
                  )
              )
;;;       ((= n 4)
;;;              (progn
    )
  )
                    
         
             
                    
                                     
                                







                          
                             
                               
                       
                  
     
                     
   
                        
               




















  

;;;  (setq Trim1_list nil)
;;;  (command "._Undo" "be")
;;;  ;;
;;;  
;;;  (while (< i (/ n 2))
;;;    (setq Trim1 (ssname TrimObj i))
;;;    (setq tr1 (entget Trim1))
;;;    (setq j 0)
;;;    (while (< j n)
;;;      (setq Trim2 (ssname TrimObj j))
;;;      (setq Tr2 (entget Trim2))
;;;      (setq p1 (Inters (cdr (assoc 10 Tr1))
;;;                       (cdr (assoc 11 Tr1))
;;;                       (cdr (assoc 10 Tr2))
;;;                       (cdr (assoc 11 Tr2))
;;;                       nil
;;;               )
;;;      )
;;;      (if (/= p1 nil)
;;;        (progn
;;;          (setq List1 (append List1 (List p1)))
;;;          (setq Trim1_list (append trim1_list (list trim1)))
;;;        )
;;;      )
;;;      (setq j (+ j 1))
;;;    )
;;;    (setq i (+ i 1))
;;;  )
;;;  ;;
;;;  (setq k 0)
;;;  (while (< k (length Trim1_list))
;;;    (setq Obj1 (ssname TrimObj k))
;;;    (if (/= obj1 nil)
;;;    (progn
;;;    (setq Tr1_Obj (entget Obj1))
;;;    (setq Int_s 0)
;;;    (setq Tr_dat nil)
;;;    (while (< Int_s (Length List1))
;;;      (setq dat1 (nth Int_s List1))
;;;      (setq dat_Total (+ (distance (cdr (assoc 10 Tr1_Obj)) dat1)
;;;                         (distance (cdr (assoc 11 Tr1_Obj)) dat1)
;;;                      )
;;;      )
;;;      (if
;;;        (= dat_Total
;;;           (distance (cdr (assoc 10 Tr1_Obj)) (cdr (assoc 11 Tr1_Obj)))
;;;        )
;;;         (setq Tr_dat (append Tr_dat (list dat1)))
;;;      )
;;;      (setq Int_s (+ Int_s 1))
;;;    )
;;;    (command "_.break"  Obj1 (car Tr_dat) (cadr Tr_dat)  )
;;;    (princ)
;;;    )
;;;      )
;;;    (setq k (+ k 1))
;;;  )
;;;  (command "_.Undo" "e")
;;;)

不过有些问题。请指教。

knightone

我也在做这个...也碰到问题了.我用一个选择集响应"break"然后"f"(nth 0 jd)"(nth 1 jd)
可就是出错....

aeo

(command "._break"  (list entname pt1) "f" pt1 pt2)