五金模具快速画脱料板挂台(吊耳)的程序

mj520plus · 发表于 2011-11-21 22:21:34

本帖最后由 mj520plus 于 2011-11-21 23:28 编辑

本人是一位菜鸟，只是懂一点点lisp知识。现在小弟遇到了一个难题，请教各位大侠：
此程序在AutoCAD2004～2008测试正常，但在AutoCAD2010中会出错！
初步判断可能是下面一行代码有问题：
(command "fillet" "r" 0 "fillet" POINT1 POINT2)

不知如何解决？还请各位大侠不吝赐教！

正常使用效果如下：

以下是源代码：
(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 (car selec1) (car selec2)) (= selec2 nil))
   (princ "无效的选择,请重选!")
   (progn (princ "1 found") (setq n 3))
)
  )    ;while
  (setq n nil)
  (IF (= HIGH1 NIL)
(SETQ HIGH1 5)
  )
  (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 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)
)

zmzk · 发表于 2022-12-9 09:28:31

奇怪，我用2014测试，可以运行，没有你说的问题

2548572928 · 发表于 2021-11-16 09:57:08

串接好的线竟然无法使用不是很完美

yang198910204 · 发表于 2011-11-21 22:31:21

这是真滴!!

yang198910204 · 发表于 2011-11-21 22:37:17

好像我有同样的
呵呵

mj520plus · 发表于 2011-11-21 23:30:51

你的程序可以在ACAD2010测试通过吗？

690994 · 发表于 2011-11-22 08:13:32

同行，
point1和point2要用entsel返回的数据形式才行，还不能是同一实体，
同一多义线这两个参数我也调不出来。

fergus1987 · 发表于 2011-11-22 09:01:38

表示没有压力

AMTONNY · 发表于 2011-11-22 20:40:27

今天我在打酱油中

xiaotao · 发表于 2011-11-23 01:12:24

曾经帮朋友写过一个，只要点击一下就可以了，可惜源码删了

mj520plus · 发表于 2011-11-23 23:40:30

经过反复调试，发现下面代码有在这2010下运行有问题：
(command "EXTEND" "l" "" point1 "")

修改如下：
(command "EXTEND" "l" "" selec1 "")

运行OK！

jfxia · 发表于 2011-11-24 16:49:27

一直用的，不知道源码，

谢分享

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

五金模具快速画脱料板挂台(吊耳)的程序

本帖子中包含更多资源

相关帖子