阶梯轴绘制

jordan

发一个阶梯轴生成程序做得不好。。。大家帮我看看，如果对你有用我就很开心了虽然要自己选点但也不是很麻烦只要点一下前一段轴的中心就可以了。。不足之处多提意见了

jordan

请大家帮忙啊。。。让程序自己找到每段轴的起点我从第三段开始就找不到了。。。

meflying

看看这个:

onej

楼上开头有一句：(vl-load-com)


有什么用，为什么要有这句话呢？

meflying

这是加载VLISP扩展函数,否则就不能使用VLISP函数

龙龙仔

2. ;;供参考
3. ;;目前只画水平向右
4. ;;指令: ttt
5. ;;指定中心位置:
6. ;;对角点: @23,45
7. ;;对角点: @45,50
8. ;;对角点: @30,56
9. ;;对角点:
10. (defun C:TTT (/ PT1 PT2 ANG DIST DX DY)
11.    (setvar "osmode" 39)
12.    (setq PT1 (getpoint "\n指定中心位置: "))
13.    (setvar "osmode" 0)
14.    (while (setq PT2 (getcorner PT1 "\n对角点: "))
15.        (command "_.rectang" PT1 PT2)
16.        (setq ANG (angle PT1 PT2))
17.        (setq DIST (distance PT1 PT2))
18.        (setq DY (abs (* DIST (sin ANG))))
19.        (setq DX (abs (* DIST (cos ANG))))
20.        (if  (> (cadr PT1) (cadr PT2))
21.            (command "_.move"
22.                (entlast)
23.                ""
24.                PT1
25.                (polar PT1 (* 0.5 pi) (/ DY 2))
26.            )
27.            (command "_.move"
28.                (entlast)
29.                ""
30.                PT1
31.                (polar PT1 (* 1.5 pi) (/ DY 2))
32.            )
33.        )
34.        (setq PT1 (polar PT1 0 DX))
35.    )
36.    (princ)
37. )

;;供参考 ;;目前只画水平向右 ;;指令: ttt ;;指定中心位置: ;;对角点: @23,45 ;;对角点: @45,50 ;;对角点: @30,56 ;;对角点: (defun C:TTT (/ PT1 PT2 ANG DIST DX DY)    (setvar "osmode" 39)    (setq PT1 (getpoint "\n指定中心位置: "))    (setvar "osmode" 0)    (while (setq PT2 (getcorner PT1 "\n对角点: "))        (command "_.rectang" PT1 PT2)        (setq ANG (angle PT1 PT2))        (setq DIST (distance PT1 PT2))        (setq DY (abs (* DIST (sin ANG))))        (setq DX (abs (* DIST (cos ANG))))        (if  (> (cadr PT1) (cadr PT2))            (command "_.move"                (entlast)                ""                PT1                (polar PT1 (* 0.5 pi) (/ DY 2))            )            (command "_.move"                (entlast)                ""                PT1                (polar PT1 (* 1.5 pi) (/ DY 2))            )        )        (setq PT1 (polar PT1 0 DX))    )    (princ) )

jordan

谢谢你们了谢谢飞哥谢谢龙哥。我会好好看看你们的代码是怎么写的我想这个程序对我有很大的启发。。。。

ZZXXQQ

楼主：程序修改后如下：可以水平方向画任意轴段，当不想画轴段时，在提示输入轴段直径时给空回车即可。 (defun c:zd( / CNT1 N D L P1 P2)
(setvar "cmdecho" 0)
(setq yhmde (getvar "osmode"))
(setvar "osmode" 0)
(setq cnt1 (getpoint"\n指定第1段轴的左边中心点:"))
(Setq n 1)
(while (setq d (getdist (strcat "\n输入第" (itoa n) "段轴的直径:")))
(setq l (getdist (strcat "\n输入第" (itoa n) "段轴的长度:")))
(setq n (1+ n))
(setq p1 (POLAR CNT1 (/ PI 2) (/ d 2)))
(SETQ CNT1 (POLAR CNT1 0 L))
(Setq p2 (POLAR CNT1 (/ PI -2) (/ d 2)))
(command "_.rectang" p1 p2)
)
(SETVAR "OSMODE" YHMDE)
(SETVAR "CMDECHO" 1)
(PRINC)
)
(PROMPT "\n键入ZD运行程序。")
(PRINC)

jordan

把程序改了一下，现在可以自动绘制任意轴段了谢谢大家

jordan

绘制阶梯轴程序（已根据龙哥的思路修改完)