算两点间距离，并定数等分这段距离

726613

根据选取第一点，再选取第二点，算出两点间距离，然后输入定数等分数量将这段距离定数等分

cie0588

1. (defun c:tt ()
   
2.   (vl-load-com)
   
3.   (setvar "CMDECHO" 0)
   
4.   (setq  p1 (getpoint "\n第一点：")
   
5.   p2 (getpoint p1 "\n第二点：")
   
6.   )
   
7. ;;;两点距离
   
8.   (princ
   
9.     (strcat "\n****两点距离:" (rtos (distance p1 p2) 2 3))
   
10.   )
    
11. ;;;等分数量：
    
12.   (setq n (getint "\n等分数量:"))
    
13. ;;;等分子函数，根据两点点及等分数量得出等分点列表
    
14.   (defun tt-df (p1 p2 n)
    
15.     (if  (> (1- n) 0)
    
16.       (cons (polar p1 (angle p1 p2) (/ (distance p1 p2) n 1.0))
    
17.       (tt-df (polar p1 (angle p1 p2) (/ (distance p1 p2) n 1.0))
    
18.        p2
    
19.        (1- n)
    
20.       )
    
21.       )
    
22.     )
    
23.   )
    
24. ;;;等分点列表
    
25.   (setq lst (tt-df p1 p2 n))
    
26. ;;; 起点、终点、等分点处画园
    
27.   (mapcar '(lambda (x)
    
28.        (vla-AddPoint
    
29.          (vla-get-modelspace
    
30.      (vla-get-activedocument (vlax-get-acad-object))
    
31.          )
    
32.          (vlax-3d-point x)
    
33.        )
    
34.      )
    
35.     (append (list p1) lst (list p2))
    
36.   )
    
37.   (prin1)
    
38. )

(defun c:tt ()<br />   (vl-load-com)<br />   (setvar "CMDECHO" 0)<br />   (setq  p1 (getpoint "\n第一点：")<br />   p2 (getpoint p1 "\n第二点：")<br />   )<br /> ;;;两点距离<br />   (princ<br />     (strcat "\n****两点距离:" (rtos (distance p1 p2) 2 3))<br />   )<br /> ;;;等分数量：<br />   (setq n (getint "\n等分数量:"))<br /> ;;;等分子函数，根据两点点及等分数量得出等分点列表<br />   (defun tt-df (p1 p2 n)<br />     (if  (> (1- n) 0)<br />       (cons (polar p1 (angle p1 p2) (/ (distance p1 p2) n 1.0))<br />       (tt-df (polar p1 (angle p1 p2) (/ (distance p1 p2) n 1.0))<br />        p2<br />        (1- n)<br />       )<br />       )<br />     )<br />   )<br /> ;;;等分点列表<br />   (setq lst (tt-df p1 p2 n))<br /> ;;; 起点、终点、等分点处画园<br />   (mapcar '(lambda (x)<br />        (vla-AddPoint<br />          (vla-get-modelspace<br />      (vla-get-activedocument (vlax-get-acad-object))<br />          )<br />          (vlax-3d-point x)<br />        )<br />      )<br />     (append (list p1) lst (list p2))<br />   )<br />   (prin1)<br /> )

duanshui83

这个很简单的，自己琢磨一下就行了

cie0588

1. (defun c:tt ()
   
2.   (setvar "CMDECHO" 0)
   
3.   (setq  p1 (getpoint "\n第一点：")
   
4.   p2 (getpoint p1 "\n第二点：")
   
5.   )
   
6. ;;;两点距离
   
7.   (princ
   
8.     (strcat "\n****两点距离:" (rtos (distance p1 p2) 2 3))
   
9.   )
   
10. ;;;等分数量：
    
11.   (setq n (getint "\n等分数量:"))
    
12. ;;;等分子函数，根据两点点及等分数量得出等分点列表
    
13.   (defun tt-df (p1 p2 n)
    
14.     (if  (> (1- n) 0)
    
15.       (cons (polar p1 (angle p1 p2) (/ (distance p1 p2) n 1.0))
    
16.       (tt-df (polar p1 (angle p1 p2) (/ (distance p1 p2) n 1.0))
    
17.        p2
    
18.        (1- n)
    
19.       )
    
20.       )
    
21.     )
    
22.   )
    
23. ;;;等分点列表
    
24.   (setq lst (tt-df p1 p2 n))
    
25. ;;; 起点、终点、等分点处画园
    
26.   (mapcar '(lambda (x) (vl-cmdf "CIRCLE" x 1.0))
    
27.     (append (list p1) lst (list p2))
    
28.   )
    
29.   (prin1)
    
30. )
    

(defun c:tt ()<br />   (setvar "CMDECHO" 0)<br />   (setq  p1 (getpoint "\n第一点：")<br />   p2 (getpoint p1 "\n第二点：")<br />   )<br /> ;;;两点距离<br />   (princ<br />     (strcat "\n****两点距离:" (rtos (distance p1 p2) 2 3))<br />   )<br /> ;;;等分数量：<br />   (setq n (getint "\n等分数量:"))<br /> ;;;等分子函数，根据两点点及等分数量得出等分点列表<br />   (defun tt-df (p1 p2 n)<br />     (if  (> (1- n) 0)<br />       (cons (polar p1 (angle p1 p2) (/ (distance p1 p2) n 1.0))<br />       (tt-df (polar p1 (angle p1 p2) (/ (distance p1 p2) n 1.0))<br />        p2<br />        (1- n)<br />       )<br />       )<br />     )<br />   )<br /> ;;;等分点列表<br />   (setq lst (tt-df p1 p2 n))<br /> ;;; 起点、终点、等分点处画园<br />   (mapcar '(lambda (x) (vl-cmdf "CIRCLE" x 1.0))<br />     (append (list p1) lst (list p2))<br />   )<br />   (prin1)<br /> )<br />

726613

726613

cie0588 发表于 2013-5-22 12:54

;  等分点处画点
  (mapcar '(lambda (x) (vl-cmdf "point" x ))
    (append (list p1) lst (list p2))
  )
  (prin1)
)

请问cie0588 应如何修改才能在等分点处画点？谢谢

cie0588

726613 发表于 2013-5-22 13:20
;  等分点处画点
  (mapcar '(lambda (x) (vl-cmdf "point" x ))
    (append (list p1) lst (list p2) ...

我画点一般用vla方法：(vla-AddPoint
               (vla-get-modelspace
                 (vla-get-activedocument (vlax-get-acad-object))
               )
               (vlax-3d-point x)
             )

726613

726613 发表于 2013-5-22 13:20
;  等分点处画点
  (mapcar '(lambda (x) (vl-cmdf "point" x ))
    (append (list p1) lst (list p2) ...

增加这一句：“(command "pdmode"  "3" "pdsize" "1")“
(command "pdmode"  "3" "pdsize" "1")
   (mapcar '(lambda (x) (vl-cmdf "point" x ))
    (append (list p1) lst (list p2))
  )
  (prin1)
)

应如何修改才能在等分点处画点？如下图


请高手指点，谢谢

726613

cie0588 发表于 2013-5-22 13:51
我画点一般用vla方法：(vla-AddPoint
               (vla-get-modelspace
                 (vla-get-activedocument (vlax- ...

我对vla一点也不懂，请问如何放在上面程序里

cie0588

;;; 起点、终点、等分点处画园
  (mapcar '(lambda (x)
             (vla-AddPoint
               (vla-get-modelspace
                 (vla-get-activedocument (vlax-get-acad-object))
               )
               (vlax-3d-point x)
             )
           )
          (append (list p1) lst (list p2))
  )

726613

cie0588 发表于 2013-5-22 14:13
;;; 起点、终点、等分点处画园
  (mapcar '(lambda (x)
             (vla-AddPoint

应如何处理？