stellajun2005 发表于 2014-5-4 22:47:46

烦请高手帮我看看，那里出错了，这个命令用不了


;; 快速画挂台的工具
(defun c:ffg (/              selec1   selec2        point1       point2          object1
             object2pp1      pp2        dist1       dist2          inter
             INTERX   INTERY   POINT1X        POINT1Y       ptrim          pextend
             P1              p2       p3        p4       p5
          )

(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 3)
)
(PRINT)
(prinC "挂台高度<")
(prinC HIGH1)
(PRINC ">:")
(setq high (getreal))

(IF (= length1 NIL)
    (SETQ length1 1.0)
)
(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)))
(setq pp1 (cdr (assoc 10 object1)))
(setq pp2 (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 2))))
          (setq pextend (list (- interx length2) (+ intery (/ high 2))))
          (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 2))))
          (SETQ P5 (LIST INTERX (+ INTERY (+ high 2))))
          (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 2))))
          (setq pextend (list (+ interx length2) (+ intery (/ high 2))))
          (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 2))))
          (SETQ P5 (LIST INTERX (+ INTERY (+ high 2))))
          (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 2))))
          (setq pextend (list (- interx length2) (- intery (/ high 2))))
          (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 2))))
          (SETQ P5 (LIST INTERX (- INTERY (+ high 2))))
          (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 2))))
          (setq pextend (list (+ interx length2) (- intery (/ high 2))))
          (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 2))))
          (SETQ P5 (LIST INTERX (- INTERY (+ high 2))))
          (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 2)) intery))
          (setq pextend (list (+ interx (/ high 2)) (- 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 2)) (+ INTERY 0.2)))
          (SETQ P5 (LIST (+ INTERX (+ high 2)) 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 2)) intery))
          (setq pextend (list (+ interx (/ high 2)) (+ 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 2)) (- INTERY 0.2)))
          (SETQ P5 (LIST (+ INTERX (+ high 2)) 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 2)) intery))
          (setq pextend (list (- interx (/ high 2)) (- 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 2)) (+ INTERY 0.2)))
          (SETQ P5 (LIST (- INTERX (+ high 2)) 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 2)) intery))
          (setq pextend (list (- interx (/ high 2)) (+ 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 2)) (- INTERY 0.2)))
          (SETQ P5 (LIST (- INTERX (+ high 2)) 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" osnapx)
(PRINC)

)




http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 stellajun2005的微博

stellajun2005 发表于 2014-5-4 22:52:08

怎么没有回应呀。在线等，谢谢了

lsjj 发表于 2014-5-5 09:17:24

1. (command "fillet" "r" 0 "fillet" selec1 selec2)
2. (command "EXTEND" "l" "" selec1 "")
3. (setvar "CMDECHO" scmde)scmde沒值

stellajun2005 发表于 2014-5-5 23:07:45

lsjj 发表于 2014-5-5 09:17 static/image/common/back.gif
1. (command "fillet" "r" 0 "fillet" selec1 selec2)
2. (command "EXTEND" "l" "" selec1 "")
3. (setv ...

可以帮我修改下吗〉谢了

lsjj 发表于 2014-5-7 08:06:03

你把1,2換掉,把3刪掉,搞定
要學寫先學改也是捷徑
页: [1]
查看完整版本: 烦请高手帮我看看，那里出错了，这个命令用不了