op90o 发表于 2022-7-5 17:22:51

不同版本的lisp proble

以下代码是否可以在AutoCAD 2016版本中执行。
但在AutoCAD 2014版本中无法执行
因为sp1和ep1的结果为零，
所以程序无法完成。
请前辈指导
非常感谢。
 
（setq obj1（vlax ename->vla对象（car ent1））
obj2（vlax ename->vla对象（car ent2））
obj3（vlax ename->vla对象（car ent3））
)
（setq sp1（vlax曲线getstartpoint obj1）
ep1（vlax曲线getendpoint obj1））
22.LSP

kpblc 发表于 2022-7-5 17:33:37

转储obj1并检查其属性和方法。我认为您正在尝试获取像INSERT或TEXT这样的实体。您没有检查实体的类型。
P、 我不懂韩语/日语/中文。

op90o 发表于 2022-7-5 17:44:23

感谢您的回复2014 32魏源无法演出
AutoCAD 2014 64威远已执行
 
AutoCAD 2008当前无法执行，请参阅以下完整程序
非常感谢。
 
(defun C:22 (/ ang1 ang2 ent1 ent2 ent3 ep1 ep3 ipt1 ipt2 ipt21
             mp1 mp3 obj1 obj2 obj3 pt1 pt2 pt3 sp1 sp3 mp11 line1 line2 line3 line4)
(vl-load-com)
(SETVAR "CMDECHO" 0)
(command "_undo" "_be")
(if (= Wh1 nil) (setq Wh1 1))
(if (= Wd1 nil) (setq Wd1 1))
(setq Wh (getREAL (strcat "\nEnter the length <" (rtos Wh1 2) ">: ")))
(setq Wd (getREAL (strcat "\nEnter the width <" (rtos Wd1 2) ">: ")))
(if (= Wh nil) (setq Wh Wh1)) (SETQ Wh1 Wh)
(if (= Wd nil) (setq Wd Wd1)) (SETQ Wd1 Wd)
(while (drwBranch))
(princ)
)

(defun drwBranch ()
(while
(setq ent1 (entsel "\nSelecting a first tube side: "))
(redraw (CAR ent1) 3)

(setq ent2 (entsel "\nSelect the second tube side: "))
   (IF (= nil ent2) (setq ent2 (entsel "\nSelect the second tube side <Esc>: ")))
   (IF (= nil ent2)
   (PROGN
(PRINC "\nNot any selected...*Esc*")
(EXIT)
)
   )
(redraw (CAR ent2) 3)

(setq ent3 (entsel "\nChoose another tube side: "))
    (IF (= nil ent3) (setq ent3 (entsel "\nChoose another tube side <Esc>: ")))
   (IF (= nil ent3)
   (PROGN
(PRINC "\nNot any selected...*Esc*")
(EXIT)
)
   )
(redraw (CAR ent3) 3)

(setq obj1 (vlax-ename->vla-object (car ent1))
   obj2 (vlax-ename->vla-object (car ent2))
   obj3 (vlax-ename->vla-object (car ent3))
   )
(setq sp1(vlax-curve-getstartpoint obj1)
   ep1(vlax-curve-getendpoint obj1)
   mp1(mapcar (function (lambda (a b) (/ (+ a b) 2))) sp1 ep1)
   sp2(vlax-curve-getstartpoint obj2)
   ep2(vlax-curve-getendpoint obj2)
   mp2(mapcar (function (lambda (a b) (/ (+ a b) 2))) sp2 ep2)
   sp3(vlax-curve-getstartpoint obj3)
   ep3(vlax-curve-getendpoint obj3)
   mp3(mapcar (function (lambda (a b) (/ (+ a b) 2))) sp3 ep3)
   ipt1 (vlax-invoke obj1 'intersectwith obj3 0)
   ipt2 (vlax-invoke obj2 'intersectwith obj3 0)
   ang1 (angle ipt1 mp1)
   ang2 (angle ipt2 ipt1)
   pt1(polar ipt1 ang1 Wh1)
   pt2(polar ipt2 ang1 Wh1)
   pt3(polar ipt1 ang2 Wd1)
   )
    (entmake   (list '(0 . "line") (cons 10 pt1) (cons 11 pt2)   ))
    (setq line1 (entlast))
    (command "_.DRAWORDER" ent3 "" "b" )
    (command "_.trim" line1 "" ipt1 ipt2 "")
    (entmake   (list '(0 . "line") (cons 10 pt1) (cons 11 pt3)   ))
    (setq line2 (entlast))
    (entmake   (list '(0 . "line") (cons 10 pt2) (cons 11 ipt2)   ))
    (setq line3 (entlast))
    (entmake   (list '(0 . "line") (cons 10 ipt2) (cons 11 pt3)   ))
    (setq line4 (entlast))
(setq mp11 (mapcar (function (lambda (a b) (/ (+ a b) 2))) pt1 pt2))
(COMMAND "copybase" mp11 line1 line2 line3 line4 "")
(COMMAND "erase" line1 line2 line3 line4 "")
(COMMAND "pasteblock" mp11)
)
(COMMAND "_undo" "_end")
(princ)
)

kpblc 发表于 2022-7-5 17:48:12

通常我没有时间创建完整的代码，尝试使用附件
tmp。lsp

CAD USER 发表于 2022-7-5 17:59:59

试试这个，
这是来自fixo#2
 
http://www.cadtutor.net/forum/showthread.php?47346-绘制支管的Lisp

op90o 发表于 2022-7-5 18:06:10

2008版仍然不是，但谢谢你的程序！

op90o 发表于 2022-7-5 18:13:48

谢谢分享！我只是指这一代的LISP:D

CAD USER 发表于 2022-7-5 18:20:15

 
我仍在使用相同的，它对我来说很好。。

SLW210 发表于 2022-7-5 18:29:53

请阅读代码发布指南并编辑您的帖子以使用代码标签。
 

Your Code Here =
Your Code Here
页: [1]
查看完整版本: 不同版本的lisp proble