请大家看看这两个程序什么地方有问题，每次使用时必须重复选择。请多多赐教！

lohas1118 · 发表于 2011-10-26 14:49:53

ZZXXQQ 发表于 2011-10-26 12:21

多谢版主，还麻烦帮看下这两个程序那错了有时能用，有时却不能用。请多多指教。不胜感激！

;;;;;;;多重剪切
(defun c:trim1()
   (setq i 0)
(repeat (sslength seltrim)
   (setq t (entget (ssname seltrim i)))
   (setq i (+ 1 i))

   (setq p1x (cadr (assoc 10 t)) p1y (caddr (assoc 10 t)) )
   (setq p2x (cadr (assoc 11 t)) p2y (caddr (assoc 11 t)) )

   (setq p1 (list p1x p1y)       p2 (list p2x p2y)          )

   (setq j 0    k 0 )

   (setq inter1 nil inter2 nil inter3 nil)
                     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                     (repeat (sslength seltrim)
                        (setq t1 (entget (ssname seltrim j)))
                        (setq j (1+ j))
                     (progn
                        (SETQ P3X (cadr (assoc 10 t1)))
                        (setq p3y (caddr (assoc 10 t1)))
                        (setq p4x (cadr (assoc 11 t1)))
                        (setq p4y (caddr (assoc 11 t1)))
                        (setq p3 (list p3x p3y))
                        (setq p4 (list p4x p4y))
                        (setq Pinter (inters P1 P2 P3 P4 ))
                        (IF (/= pinter nil) (setq k (+ k 1)) )
                        (IF (and (= K 1) (/= PINTER NIL) )    (SETQ INTER1 PINTER)    )
                        (if (and (= k 2) (/= pinter nil) )    (SETQ INTER2 PINTER)    )

                                          (if (= k 2) (progn  (SETQ DIST1 (DISTANCE INTER1 P1) DIST2 (DISTANCE INTER2 P1) )
                                                   (if (> dist1 dist2) (setq point inter1 inter1 inter2 inter2 point) )
                                                         )
                                          )
                                    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                    (if (and (> k 2) (/= pinter nil) )
                                       (progn
                                          (SETQ INTER3 PINTER)
                                          (SETQ DIST1 (DISTANCE INTER1 P1) DIST2 (DISTANCE INTER2 P2) )
                                          (SETQ DIST3 (DISTANCE INTER3 P1))
                                          (SETQ DIST4 (DISTANCE INTER3 P2))

                                          (if (> dist1 dist3) (setq inter1 inter3) )
                                          (if (> dist2 dist4) (setq inter2 inter3) )
                                          (setq pinter nil)
                                          (setq dist1 nil dist2 nil dist3 nil dist4 nil)
                                       )

                                    )
                                    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

                     )
                     )
                  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                  (if (/= (and inter1 inter2) nil)
                     (progn
                        (setq mp1 (list 10 (car inter1) (cadr inter1) ) )
                        (setq t (subst mp1 (assoc 10 t) t))
                        (setq mp2 (list 11 (car inter2) (cadr inter2) ) )
                        (setq t (subst mp2 (assoc 11 t) t))
                        (entmod t)
                     )
                  )

)
)
;;;
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;子程序trim2开始;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:trim2()
   (setvar "osmode" 0)
   (setq point1x (car point1))
   (setq point1y (cadr point1))
   (setq point3x (car point3))
   (setq point3y (cadr point3))
   (setq point2 (list point1x point3y))
   (setq point4 (list point3x point1y))
   ;(PRINT)
   ;(PRINC "POINT1=")(PRIN1 POINT1)
   ;(PRINT)
   ;(PRINC "POINT2=")(PRIN1 POINT2)
   ;(PRINT)
   ;(PRINC "POINT3=")(PRIN1 POINT3)
   ;(PRINT)
   ;(PRINC "POINT4=")(PRIN1 POINT4)
  (IF (OR  (=  POINT1X POINT3X)  (=  POINT1Y POINT3Y)  )
(PROGN
(command "trim" SELTRIM "" )
(COMMAND "f"  point1 POINT3 "" "")
(command "trim" SELTRIM "" )
(COMMAND "f"  point3 POINT1 "" "")
)

(PROGN
(command "trim" SELTRIM "" )
(COMMAND "f"  point1 point2 POINT3 POINT4 "" "")
(command "trim" SELTRIM "" )
(COMMAND "f"  point4 point3 point2 point1 POINT4 "" "")
)
)

(setq tr 10)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;子程序trim2完成;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;以下是主程序

(DEFUN C:TR ()
(start00)
(setvar "osmode" 0)
(SETQ EDGEMODEED (GETVAR "EDGEMODE"))
(SETVAR "EDGEMODE" 1)
(setq tr nil)
(prompt "\nSelect cutting edges:")
(setq seltrim (ssget))
(prompt "\nSelect object to trim")
(setq point1 (getpoint "\nEnter the 1st point:")  )
(if (and seltrim (null point1 ))  (c:trim1)  )
;;;;;;;;
(IF (/= POINT1 NIL)
   (PROGN
      (setq kit nil)
      (setq kit 1)
   (while (< kit 5)
      (setq point3 (getcorner point1 "\nEnter the 2st point:")  )
   (if (null point3) (princ "无效的点!请重输:")(setq kit 6)
      );if
      );while
      (setq kit nil)
      (setq seltrimed (ssget "c" point1  point3 )  )
      (IF (and (= TR NIL) (/= seltrimed nil) ) (C:TRIM2) )
      (setq xxxx 0)
   (if (= tr 10)
   (while (< xxxx 5)
      (prompt "\nSelect object to trim")
      (setq point1 (getpoint "\nEnter the 1st point:")  )
   (if (/= point1 nil)
      (progn
      (setq kit nil)
      (setq kit 1)
   (while (< kit 5)
      (setq point3 (getcorner point1 "\nEnter the 2st point:")  )
   (if (null point3) (princ "无效的点!请重输:")(setq kit 6)
      );if
      );while
      (setq kit nil)
      (setq seltrimed (ssget "c" point1  point3 )  )
      (if (/= seltrimed nil) (c:trim2) )
      )
      (setq xxxx 10)
      )
   )
   )
   )
)
;;;;;;;
(COMMAND "UCS" "P" )
(setvar "osmode" 15359)
(SETVAR "EDGEMODE" EDGEMODEED)
(setq tr nil)
(command "_.UNDO" "_E")
(setvar "osmode" 15359)
(PRINC )
)
;;;
;;;;;;;;;
;;;;;;;;;
;;;;;;;;;;;

;;;;;;;快速制块程序
(defun c:kk ()
(start00)
(setvar "osmode" 0)
(setq sel (ssget))
(setq poin (cdr (assoc 10 (entget (ssname sel  0)))) )
(setq qqqq (cadr (grread)))
(setq qqqqy (itoa (fix (abs (* 10000 (cadr qqqq))))))
(setq qqqqx (itoa (fix (abs (* 10000 (car qqqq))))))
(setq qqqq (strcat qqqqx qqqqy))
(setq ww qqqq)
(setq bqqqq (strcat "b" qqqq))
(if (null qqqq) (setq qqqq 1))

(setq k 1)
(while (< k 5)
(if (tblsearch "block" bqqqq)
(progn
         (setq qqqq (+ 1 qqqq))
      (setq bqqqq (strcat "b" qqqq))
   );progn
(setq k 10));if
);while
;(ssget)
;(command "chprop" "p" "" "c" "byblock" "")
(command "block" bqqqq poin "p" "")
;(command "color" "byblock" )
(command "insert" bqqqq poin "" "" "")
;(command "color" "bylayer")
;(command "chprop" "l" "" "c" "byblock" "")
(setvar "osmode" osnap1)
(setq k nil)
(setq qqqq nil poin nil qqqqx nil qqqqy nil bqqqq nil)
(command "_.UNDO" "_E")
(princ )
)

;;;;;;;多重延伸
(defun exarc (arc / edba ctr sang eang radi sp ep)
  (setq edba (entget arc))
  (setq ctr (cdr (assoc 10 edba)))
  (setq sang (cdr (assoc 50 edba)))
  (setq eang (cdr (assoc 51 edba)))
  (setq radi (cdr (assoc 40 edba)))
  (setq sp (polar ctr sang radi))(setq ep (polar ctr eang radi))
  (if (> (distance esp sp)(distance esp ep)) (setq sp ep))
  (command "extend" edge "" sp ""))

(defun exline (line / sp ep inti into)
  (setq sp (findend1 line))(setq ep (findend2 line))
  (setq into (inters sp ep esp eep nil))
  (setq inti (inters sp ep esp eep t))
  (if (and (= inti nil) (/= into nil))
(command "change" line "" into)))

(defun ckandex (sset / ln i ent typ)
  (setq ln (sslength sset))
  (setq i 0)(setvar "cmdecho" 0)
  (while (< i ln)
(setq ent (ssname sset i))
(setq typ (cdr (assoc 0 (entget ent))));get the object type
(cond ((= typ "LINE") (exline ent));extend it according to its type
   ((= typ "ARC") (exarc ent)))
(setq i (1+ i))))

(defun findend1 (l)
  (cdr (assoc 10 (entget l))))

(defun findend2 (l)
  (cdr (assoc 11 (entget l))))

(defun getline (prom / ck line otype)
  (setq ck "n")
  (while (= ck "n")
(terpri)(setq temp (entsel prom))
(if (= temp nil)
   (prompt "\n没有选到任何物件请再选一次...")
   (progn (setq line temp)
      (setq line (nth 0 line))
      (setq otype (cdr (assoc 0 (entget line))))
      (if (= otype "LINE")
         (setq ck "y")
         (prompt "\n这不是线，请再选一次...")))))
  (eval line))

(defun C:EX (/ edge esp eep p1 p2 exts)
  (setq edge (getline (strcat "\n" "请点取边界线 !")))
  (setq esp (findend1 edge))
  (setq eep (findend2 edge))
  (prompt "\n请点取二点开框来选取要延伸的图形 ....")
  (setq p1 (getpoint "\n请输入选取框的第一点 : "))
  (setq p2 (getcorner p1 "\n请输入选取框的第二点: "))
  (setq exts (ssget "c" p1 p2))
  (ckandex exts))
;;;
;;;;;;;;;
;;;;;;;;;
;;;;;;;;;;;

lohas1118 · 发表于 2011-10-27 11:22:08

lohas1118 发表于 2011-10-26 14:49
多谢版主，还麻烦帮看下这两个程序那错了有时能用，有时却不能用。请多多指教。不胜感激！

;;;;;;;多重 ...

大家都帮忙看下吧

lohas1118 · 发表于 2011-10-28 10:12:13

大家都帮我看看吧[em0]

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