[已解决]请高手帮忙做个简单的等分工具

198526

回复 ljpnb 的帖子

是我考虑不周，谢谢提醒！

zhynt

回复 1078815748 的帖子

不知道你要什么样的效果。

ljpnb

zhynt 发表于 2011-6-20 21:05
也来凑个热闹(改了一下）
修改了一下，相对完美了一些。

我看程序还不够完美，当等分线与参考线不垂直时，出来的结果会不一样。。
我图片贴不上来，不然会一看就明白了。。。。

zhynt

回复 ljpnb 的帖子

哦，按你的要求改了一下，增加参考线方向的判断：

2. 
   
3.   (setq ptangle (angle pt1 pt2)
   
4.           ptangle2 (angle pt3 pt4)          ;参考线角度
   
5.           ptn (polar pta ptangle2 0.01)   ;按参考线方向生成参考点
   
6.           jpt (inters pta ptn pt1 pt2 nil)
   
7.           ang (angle jpt pta)
   
8.            l3 (/ (- l1 (* jianju (- n 1))) n)
   
9.           pt5 (polar pt1 ptangle l3)
   
10.   )
    

<br />   (setq ptangle (angle pt1 pt2)<br />           ptangle2 (angle pt3 pt4)          ;参考线角度<br />           ptn (polar pta ptangle2 0.01)   ;按参考线方向生成参考点<br />           jpt (inters pta ptn pt1 pt2 nil)<br />           ang (angle jpt pta)<br />            l3 (/ (- l1 (* jianju (- n 1))) n)<br />           pt5 (polar pt1 ptangle l3)<br />   )<br />

ljpnb

1078815748 发表于 2011-6-21 12:07
回复 1078815748 的帖子

遇到这样的分格总是用手算出来再把点放上去，工作用量太大了，也太麻烦了，总想找 ...

2. 
   
3. (defun c:test ()
   
4.   (princ "\n请选择需要等分的圆弧:")
   
5.   (if (setq ss (ssget '((0 . "ARC"))))
   
6.     (progn
   
7.       (setq n (getint "\n 输入几个大格:"))
   
8.       (or (setq l (getreal "\n输入小格弧长<15>:")) (setq l 15.))
   
9.       (setq i 0)
   
10.       (setq os (getvar "osmode"))
    
11.       (setvar "osmode" 0)
    
12.       (setvar "pdmode" 34);;值可以设定其它的           
    
13.       (SETVAR "CMDECHO" 0)
    
14.       (command "undo" "g")
    
15.       (repeat (sslength ss)
    
16.         (setq obj (vlax-Ename->Vla-Object (ssname ss i)))
    
17.         (setq len (vla-get-arclength obj))
    
18.         (setq dis (/ (- len (* l (1- n))) n))
    
19.         (setq k 1.)
    
20.         (repeat        (1- n)
    
21.           (setq        point1
    
22.                  (vlax-curve-getPointAtDist obj (+ (* k dis) (* (1- k) l)))
    
23.           )
    
24.           (setq        point2
    
25.                  (vlax-curve-getPointAtDist obj (+ (* k dis) (* k l)))
    
26.           )
    
27.           (command "point" point1)
    
28.           (command "point" point2)
    
29.           (setq k (1+ k))
    
30.         )
    
31.         (setq i (1+ i))
    
32.       )
    
33.     )
    
34.   )
    
35.   (setvar "osmode" os)
    
36.   (command "undo" "e")
    
37.   (SETVAR "CMDECHO" 1)
    
38.   (princ)
    
39. )
    

<br /> (defun c:test ()<br />   (princ "\n请选择需要等分的圆弧:")<br />   (if (setq ss (ssget '((0 . "ARC"))))<br />     (progn<br />       (setq n (getint "\n 输入几个大格:"))<br />       (or (setq l (getreal "\n输入小格弧长<15>:")) (setq l 15.))<br />       (setq i 0)<br />       (setq os (getvar "osmode"))<br />       (setvar "osmode" 0)<br />       (setvar "pdmode" 34);;值可以设定其它的           <br />       (SETVAR "CMDECHO" 0)<br />       (command "undo" "g")<br />       (repeat (sslength ss)<br />         (setq obj (vlax-Ename->Vla-Object (ssname ss i)))<br />         (setq len (vla-get-arclength obj))<br />         (setq dis (/ (- len (* l (1- n))) n))<br />         (setq k 1.)<br />         (repeat        (1- n)<br />           (setq        point1<br />                  (vlax-curve-getPointAtDist obj (+ (* k dis) (* (1- k) l)))<br />           )<br />           (setq        point2<br />                  (vlax-curve-getPointAtDist obj (+ (* k dis) (* k l)))<br />           )<br />           (command "point" point1)<br />           (command "point" point2)<br />           (setq k (1+ k))<br />         )<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (setvar "osmode" os)<br />   (command "undo" "e")<br />   (SETVAR "CMDECHO" 1)<br />   (princ)<br /> )<br />

xyp1964

另类等分