paulpipi 发表于 2019-7-27 16:37:25

问题已解决，谢谢各位！

本帖最后由 paulpipi 于 2021-8-4 07:37 编辑



(defun start00 ()
(setq olderr *error*
*error* clerr
)
(setq osnap_old (getvar "osmode"))
(setq scmde (getvar "CMDECHO"))
(setq clay (getvar "CLAYER"))
(setq sblip (getvar "BLIPMODE"))
(setq sgrid (getvar "GRIDMODE"))
(setq shl (getvar "HIGHLIGHT"))
(setq sucsf (getvar "UCSFOLLOW"))
(setvar "CMDECHO" 0)
(command "_.UNDO" "_GROUP")
(command "_.UCS" "")
)

(defun c:dfg (/      selec1 selec2point1   point2   object1
       object2pp1 pp2dist1   dist2    inter
       INTERX   INTERY POINT1XPOINT1Yptrim    pextend
       P1       p2 p3p4   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 (cadr selec1) (cadr selec2)) (= selec2 nil))
      (princ "无效的选择,请重选!")
      (progn (princ "1 found") (setq n 3))
    )
)   ;while
(setq n nil)
(IF (= HIGH1 NIL)
    (SETQ HIGH1 5)
)
(PRINT)

(prinC HIGH1)
(PRINC ">:")
(setq high (getreal))
(IF (= length1 NIL)
    (SETQ length1 1.0)
)
(PRINT)

(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 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_old）
(PRINC)
)


lee50310 发表于 2021-8-3 11:06:23

本帖最后由 lee50310 于 2021-8-3 11:18 编辑

最後一行出錯了(setvar "osmode" osnap)

               改為   (setvar "osmode" osnap_old )

tryhi 发表于 2021-8-3 15:19:47

知道为什么没什么人回复吗？你这样标题不符合版规，没删已经不错了
看置顶帖，本版关于提问的一些注意事项：http://bbs.mjtd.com/thread-93736-1-1.html

paulpipi 发表于 2019-8-20 00:25:27

xinxirong 发表于 2019-8-16 07:20
写程序不留bug都不好意思说自己是程序员

高手，能帮忙修改一下吗？急用，谢谢！

paulpipi 发表于 2019-7-27 22:21:30

paulpipi 发表于 2019-7-31 21:25:44

怎么没人理？

paulpipi 发表于 2019-7-31 21:26:04

怎么没人理？

paulpipi 发表于 2019-8-16 07:12:49

有没有高手帮忙看一下呀？

xinxirong 发表于 2019-8-16 07:20:49

写程序不留bug都不好意思说自己是程序员

ketxu 发表于 2019-8-26 00:59:48

I can't see any reason to make difference between 32&64 bit code :(

paulpipi 发表于 2021-8-2 22:44:34

kkq0305 发表于 2021-8-3 00:35:28

command 尽量不要用   版本不一样 command命令流 不太一样
页: [1] 2
查看完整版本: 问题已解决，谢谢各位！