求转出槽孔每个点坐标成文本文件的LISP!

sailorcwx

我写了一个，不过测出的坐标跟你的图不对应。你的图上的坐标自己标的？不对应CAD的坐标系

3. (defun c:cs(/ X YH_BO YH_FILE YH_LE YH_PT1 YH_PTL)
4.   (vl-load-com)
5.   (command)
6.   (setq YH_pt1 (getpoint "\n选择空内部点或者右键选择孔边界:"))
7.   (if YH_pt1
8.     (progn
9.       (setq YH_le (entlast)
10.      YH_ptl '()
11.      )
12.       (command "boundary" "a" "i" "n" "" "" YH_pt1 "")
13.       (setq YH_bo (entlast))
14.       (if (eq YH_le YH_bo)
15. (alert "错误，所选区域不封闭！")
16. (progn
17.    (mapcar '(lambda (x) (if (= (car x) 10) (setq YH_ptl (append YH_ptl (list (cdr x)))))) (entget YH_bo))
18.    (setq YH_file (open "C:\\1.txt" "W"))
19.    (mapcar '(lambda (x) (write-line (strcat "X" (rtos (car X)) "Y" (rtos (cadr X))) YH_file)) YH_ptl)
20.    (close YH_file)
21.    (startapp "notepad" "C:\\1.txt")
22.    (entdel YH_bo)
23.    )
24. )
25.       )
26.     (alert "此功能未完成")
27.     )
28.   )

(defun c:cs(/ X YH_BO YH_FILE YH_LE YH_PT1 YH_PTL)   (vl-load-com)   (command)   (setq YH_pt1 (getpoint "\n选择空内部点或者右键选择孔边界:"))   (if YH_pt1     (progn       (setq YH_le (entlast)      YH_ptl '()      )       (command "boundary" "a" "i" "n" "" "" YH_pt1 "")       (setq YH_bo (entlast))       (if (eq YH_le YH_bo) (alert "错误，所选区域不封闭！") (progn    (mapcar '(lambda (x) (if (= (car x) 10) (setq YH_ptl (append YH_ptl (list (cdr x)))))) (entget YH_bo))    (setq YH_file (open "C:\\1.txt" "W"))    (mapcar '(lambda (x) (write-line (strcat "X" (rtos (car X)) "Y" (rtos (cadr X))) YH_file)) YH_ptl)    (close YH_file)    (startapp "notepad" "C:\\1.txt")    (entdel YH_bo)    ) )       )     (alert "此功能未完成")     )   )

yth0407

谢谢楼上的兄弟,能不能写得转出来每个槽孔的坐标最后一个跟第一个是一样的,就是从哪一点开始最后也是回到那一点,一个槽孔才算闭合啊,还有能不能写得能够连续转出多个槽孔点的坐标?麻烦sailorcwx兄再帮帮忙,谢谢!

sailorcwx

(defun c:cs(/ X YH_BO YH_FILE YH_INDEX YH_LE YH_PT1 YH_PTL YH_PTL1)
  (vl-load-com)
  (command)
  (setq YH_ptl '())
  (while (setq YH_pt1 (getpoint "\n选择孔内部点或者右键退出:"))
    (setq YH_le (entlast))
    (command "boundary" "a" "i" "n" "" "" YH_pt1 "")
    (setq YH_bo (entlast))
    (setq YH_ptl1 '())
    (if (eq YH_le YH_bo)
      (alert "错误，所选区域不封闭！")
      (progn
 (mapcar '(lambda (x) (if (= (car x) 10) (setq YH_ptl1 (append YH_ptl1 (list (cdr x)))))) (entget YH_bo))
 (entdel YH_bo)
 )
      )
    (if YH_ptl1 (setq YH_ptl (append YH_ptl (list YH_ptl1))))
    )
  (if YH_ptl
    (progn
      (setq YH_file (open "C:\\1.txt" "W")
     YH_index 0
     )
      (repeat (length YH_ptl)
 (setq YH_ptl1 (nth YH_index YH_ptl))
 (write-line (strcat "======第" (rtos (1+ YH_index) 2 0) "个孔顶点坐标======") YH_file)
 (mapcar '(lambda (x) (write-line (strcat "X" (rtos (car X)) "Y" (rtos (cadr X))) YH_file)) YH_ptl1)
 (write-line "" YH_file)
 (setq YH_index (1+ YH_index))
 )
      (close YH_file)
      (startapp "notepad" "C:\\1.txt")
      )
    )
  )

yth0407

能连续了但是每个孔还是不能回到开始那个点啊?就是每个槽孔第一点开始,最后一点还是回到第一点的?sailorcwx兄再帮忙看看.

sailorcwx

哦，忘记了

3. (defun c:cs(/ X YH_BO YH_FILE YH_INDEX YH_LE YH_PT1 YH_PTL YH_PTL1)
4.   (vl-load-com)
5.   (command)
6.   (setq YH_ptl '())
7.   (while (setq YH_pt1 (getpoint "\n选择孔内部点或者右键退出:"))
8.     (setq YH_le (entlast))
9.     (command "boundary" "a" "i" "n" "" "" YH_pt1 "")
10.     (setq YH_bo (entlast))
11.     (setq YH_ptl1 '())
12.     (if (eq YH_le YH_bo)
13.       (alert "错误，所选区域不封闭！")
14.       (progn
15. (mapcar '(lambda (x) (if (= (car x) 10) (setq YH_ptl1 (append YH_ptl1 (list (cdr x)))))) (entget YH_bo))
16. (entdel YH_bo)
17. )
18.       )
19.     (if YH_ptl1 (setq YH_ptl (append YH_ptl (list (append YH_ptl1 (list (car YH_ptl1)))))))
20.     )
21.   (if YH_ptl
22.     (progn
23.       (setq YH_file (open "C:\\1.txt" "W")
24.      YH_index 0
25.      )
26.       (repeat (length YH_ptl)
27. (setq YH_ptl1 (nth YH_index YH_ptl))
28. (write-line (strcat "======第" (rtos (1+ YH_index) 2 0) "个孔顶点坐标======") YH_file)
29. (mapcar '(lambda (x) (write-line (strcat "X" (rtos (car X)) "Y" (rtos (cadr X))) YH_file)) YH_ptl1)
30. (write-line "" YH_file)
31. (setq YH_index (1+ YH_index))
32. )
33.       (close YH_file)
34.       (startapp "notepad" "C:\\1.txt")
35.       )
36.     )
37.   )

(defun c:cs(/ X YH_BO YH_FILE YH_INDEX YH_LE YH_PT1 YH_PTL YH_PTL1)   (vl-load-com)   (command)   (setq YH_ptl '())   (while (setq YH_pt1 (getpoint "\n选择孔内部点或者右键退出:"))     (setq YH_le (entlast))     (command "boundary" "a" "i" "n" "" "" YH_pt1 "")     (setq YH_bo (entlast))     (setq YH_ptl1 '())     (if (eq YH_le YH_bo)       (alert "错误，所选区域不封闭！")       (progn (mapcar '(lambda (x) (if (= (car x) 10) (setq YH_ptl1 (append YH_ptl1 (list (cdr x)))))) (entget YH_bo)) (entdel YH_bo) )       )     (if YH_ptl1 (setq YH_ptl (append YH_ptl (list (append YH_ptl1 (list (car YH_ptl1)))))))     )   (if YH_ptl     (progn       (setq YH_file (open "C:\\1.txt" "W")      YH_index 0      )       (repeat (length YH_ptl) (setq YH_ptl1 (nth YH_index YH_ptl)) (write-line (strcat "======第" (rtos (1+ YH_index) 2 0) "个孔顶点坐标======") YH_file) (mapcar '(lambda (x) (write-line (strcat "X" (rtos (car X)) "Y" (rtos (cadr X))) YH_file)) YH_ptl1) (write-line "" YH_file) (setq YH_index (1+ YH_index)) )       (close YH_file)       (startapp "notepad" "C:\\1.txt")       )     )   )

yth0407

谢谢,非常感谢.

yth0407

sailorcwx兄写的已基本上可以满足了,再次感谢sailorcwx兄,真是太谢谢了.

yth0407

sailorcwx兄能不能再出来帮帮忙，能不能把这程式再改一下，比如一个异形孔两线的交点有了R角，也能转出这R角的中点坐标。

sailorcwx

什么是R角。锐角？

ZZXXQQ

试试看能否满足要求。

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0