多重剪切,求修改

lohas1118 · 发表于 2012-2-15 10:37:32

多重剪切,求修改
加载使用后,对像捕捉一个都没有了.每次用完此命令都必须重新设定,太麻烦了.求高人指点并修改.
捕捉需要,端点,中点,圆心,象限点,交点,垂足,最近点.

**********************************************************************************************************************
;;;;;;;多重剪切
(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 ()
(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)
      )
   )
   )
   )
)
;;;;;;;
(setvar "osmode" 15359)
(SETVAR "EDGEMODE" EDGEMODEED)
(setq tr nil)
(command "_.UNDO" "_E")
(setvar "osmode" 15359)
(PRINC )
)
;;;
;;;;;;;;;
;;;;;;;;;
;;;;;;;;;;;

adc · 发表于 2012-2-15 10:37:33

(setvar "osmode" 15359)里面的数字改成695

lohas1118 · 发表于 2012-2-15 10:38:24

坐等高人

lohas1118 · 发表于 2012-2-16 10:49:12

adc 发表于 2012-2-15 10:37
(setvar "osmode" 15359)里面的数字改成695

多谢指点,已经解决.

hehaidizhi · 发表于 2014-8-4 19:47:31

下载了，谢谢

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

多重剪切,求修改

最佳答案

相关帖子

浏览过的版块