guoliangx 发表于 2015-9-10 20:46:10

07版以上用不了

(defun c:GT(/ selec1 selec2 point1 point2 object1 object2 pp1 pp2 dist1 dist2
            inter INTERX INTERY POINT1X POINT1Y ptrim pextend P1 p2 p3 p4 p5)
       (start00)
(setvar "osmode" 0)
       (setq n 1)
      (while (< n 2)
      (print)
      (setq selec1 (entsel "匡拒膀非絬:"))
      (if (= selec1 nil) (princ "礚匡拒,叫匡!") (progn (setq n 3) (princ "1 found")))
      );while

      (setq n 1)
      (while (< n 2)
      (print)
      (setq selec2 (entsel "匡拒絬:"))
      (if (or (equal (car selec1) (car selec2)) (= selec2 nil))
          (princ "礚匡拒,叫匡!") (progn (princ "1 found") (setq n 3)) )
      );while
      (setq n nil)


      (IF (= HIGH1 NIL) (SETQ HIGH1 4) )
      (PRINT)(prinC "本蔼<")(prinC HIGH1)(PRINC ">:")
      (setq high (getreal ))

      (IF (= length1 NIL) (SETQ length1 0.5) )
      (PRINT)(prinC "本<")(prinC length1)(PRINC ">:")
      (setq length2 (getreal ))
      (IF (= length2 NIL) (SETQ length2 length1) )


      (IF (= HIGH NIL) (SETQ HIGH HIGH1) )
      (setq point1 (CAdr selec1))
      (setq point2 (CAdr selec2))
(command "fillet" "r" 0 "fillet"POINT1 POINT2)
(setq object1 (ENTGET (car selec1)))
(setq object2 (ENTGET (car selec2)))
   (setqpp1 (cdr (assoc 10 object1))   )
   (setqpp2 (cdr (assoc 11 object1))   )      
   (setq dist1 (DISTANCE pp1 point1))
   (setq dist2 (distance pp2 point1))
   (if (> dist1 dist2) (setq inter pp2) (setq inter pp1) )
(SETQ INTERX (CAR INTER))
(SETQ INTERY (CADR INTER))
(SETQ POINT1X (CAR POINT1))
(SETQ POINT1Y (CADR POINT1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (and (equal (cadr pp1) (cadr pp2) 0.001 ) (> (cadr point2) (cadr point1) ) )
(progn
(IF (> POINT1X INTERX)
   (PROGN
    (setq ptrim (list interx (+ intery (/ high 1))))
    (setq pextend (list (- interx length2) (+ intery (/ high 1))))
    (SETQ P1 (LIST (- INTERX length2) INTERY))
    (SETQ P2 (LIST (- INTERX length2) (+ INTERY high) ) )
    (SETQ P3 (LIST (+ INTERX 0.2) (+ INTERY high) ) )
    (SETQ P4 (LIST (+ INTERX 0.2) (+ INTERY (+ high 1)) ) )
    (SETQ P5 (LIST INTERX (+ INTERY (+ high 1) ) ) )
    (COMMAND "LINE" P1 P2 "")
    (command "EXTEND" "l" "" point1 "")
    (command "line" p2 P3 P4 P5 "")
    (command "trim" "l" "" "f" p1 p3 "" "")
    )

   (PROGN
    (setq ptrim (list interx (+ intery (/ high 1) )))
    (setq pextend (list (+ interx length2) (+ intery (/ high 1) )))
    (SETQ P1 (LIST (+ INTERX length2) INTERY))
    (SETQ P2 (LIST (+ INTERX length2) (+ INTERY high) ) )
    (SETQ P3 (LIST (- INTERX 0.2) (+ INTERY high) ) )
    (SETQ P4 (LIST (- INTERX 0.2) (+ INTERY (+ high 1) ) ) )
    (SETQ P5 (LIST INTERX (+ INTERY (+ high 1) ) ) )
    (COMMAND "LINE" P1 P2 "")
    (command "EXTEND" "l" "" point1 "")
    (command "line" p2 P3 P4 P5 "")
    (command "trim" "l" "" "f" p1 p3 "" "")
    )

)
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (and (equal (cadr pp1) (cadr pp2) 0.001 ) (< (cadr point2) (cadr point1) ) )
(progn
(IF (> POINT1X INTERX)
   (PROGN
    (setq ptrim (list interx (- intery (/ high 1) )))
    (setq pextend (list (- interx length2) (- intery (/ high 1) )))
    (SETQ P1 (LIST (- INTERX length2) INTERY))
    (SETQ P2 (LIST (- INTERX length2) (- INTERY high) ) )
    (SETQ P3 (LIST (+ INTERX 0.2) (- INTERY high) ) )
    (SETQ P4 (LIST (+ INTERX 0.2) (- INTERY (+ high 1) ) ) )
    (SETQ P5 (LIST INTERX (- INTERY (+ high 1) ) ) )
    (COMMAND "LINE" P1 P2 "")
    (command "EXTEND" "l" "" point1 "")
    (command "line" p2 P3 P4 P5 "")
    (command "trim" "l" "" "f" p1 p3 "" "")
    )

   (PROGN
    (setq ptrim (list interx (- intery (/ high 1))))
    (setq pextend (list (+ interx length2) (- intery (/ high 1))))
    (SETQ P1 (LIST (+ INTERX length2) INTERY))
    (SETQ P2 (LIST (+ INTERX length2) (- INTERY high) ) )
    (SETQ P3 (LIST (- INTERX 0.2) (- INTERY high) ) )
    (SETQ P4 (LIST (- INTERX 0.2) (- INTERY (+ high 1) ) ) )
    (SETQ P5 (LIST INTERX (- INTERY (+ high 1) ) ) )
    (COMMAND "LINE" P1 P2 "")
    (command "EXTEND" "l" "" point1 "")
    (command "line" p2 P3 P4 P5 "")
    (command "trim" "l" "" "f" p1 p3 "" "")
    )

)
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (and (equal (car pp1) (car pp2) 0.001 ) (> (car point2) (car point1) ) )
(progn
(IF (> POINT1y INTERy)
   (PROGN
    (setq ptrim (list (+ interx (/ high 1) ) intery ))
    (setq pextend (list (+ interx (/ high 1) ) (- intery length2)))
    (SETQ P1 (LIST INTERX(- INTERY length2) ))
    (SETQ P2 (LIST (+ INTERX high) (- INTERY length2) ) )
    (SETQ P3 (LIST (+ INTERX high) (+ INTERY 0.2) ) )
    (SETQ P4 (LIST (+ INTERX (+ high 1) ) (+ INTERY 0.2) ) )
    (SETQ P5 (LIST (+ INTERX (+ high 1) )INTERY) )
    (COMMAND "LINE" P1 P2 "")
    (command "EXTEND" "l" "" point1 "")
    (command "line" p2 P3 P4 P5 "")
    (command "trim" "l" "" "f" p1 p3 "" "")
    )

   (PROGN
    (setq ptrim (list (+ interx (/ high 1) ) intery ))
    (setq pextend (list (+ interx (/ high 1) ) (+ intery length2)))
    (SETQ P1 (LIST INTERX(+ INTERY length2) ))
    (SETQ P2 (LIST (+ INTERX high) (+ INTERY length2) ) )
    (SETQ P3 (LIST (+ INTERX high) (- INTERY 0.2) ) )
    (SETQ P4 (LIST (+ INTERX (+ high 1) ) (- INTERY 0.2) ) )
    (SETQ P5 (LIST (+ INTERX (+ high 1) )INTERY) )
    (COMMAND "LINE" P1 P2 "")
    (command "EXTEND" "l" "" point1 "")
    (command "line" p2 P3 P4 P5 "")
    (command "trim" "l" "" "f" p1 p3 "" "")
    )

)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (and (equal (car pp1) (car pp2) 0.001 ) (< (car point2) (car point1) ) )
(progn
(IF (> POINT1y INTERy)
   (PROGN
    (setq ptrim (list (- interx (/ high 1) ) intery ))
    (setq pextend (list (- interx (/ high 1) ) (- intery length2)))
    (SETQ P1 (LIST INTERX(- INTERY length2) ))
    (SETQ P2 (LIST (- INTERX high) (- INTERY length2) ) )
    (SETQ P3 (LIST (- INTERX high) (+ INTERY 0.2) ) )
    (SETQ P4 (LIST (- INTERX (+ high 1) ) (+ INTERY 0.2) ) )
    (SETQ P5 (LIST (- INTERX (+ high 1) )INTERY) )
    (COMMAND "LINE" P1 P2 "")
    (command "EXTEND" "l" "" point1 "")
    (command "line" p2 P3 P4 P5 "")
    (command "trim" "l" "" "f" p1 p3 "" "")
    )

   (PROGN
    (setq ptrim (list (- interx (/ high 1) ) intery ))
    (setq pextend (list (- interx (/ high 1)) (+ intery length2)))
    (SETQ P1 (LIST INTERX(+ INTERY length2) ))
    (SETQ P2 (LIST (- INTERX high) (+ INTERY length2) ) )
    (SETQ P3 (LIST (- INTERX high) (- INTERY 0.2) ) )
    (SETQ P4 (LIST (- INTERX (+ high 1) ) (- INTERY 0.2) ) )
    (SETQ P5 (LIST (- INTERX (+ high 1) )INTERY) )
    (COMMAND "LINE" P1 P2 "")
    (command "EXTEND" "l" "" point1 "")
    (command "line" p2 P3 P4 P5 "")
    (command "trim" "l" "" "f" p1 p3 "" "")
    )

)
)
)


(SETQ HIGH1 HIGH)
(setq length1 length2)
(setq length2 nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "_.UCS" "_P")            
(command "_.UNDO" "_E")
(setvar "CMDECHO" scmde)
(setvar "osmode" osnap)
(PRINC "е硉酶籹本 ")(princ)
)


waterchen 发表于 2015-9-10 22:51:18

本帖最后由 waterchen 于 2015-9-10 22:57 编辑

程序里面好像有繁体字，你把原程序上传才成哦。还缺函数(start00)。
页: [1]
查看完整版本: 07版以上用不了