问题已解决，谢谢各位！

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 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 (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 命令流不太一样

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

[提问] 问题已解决，谢谢各位！