画中心线的小程序

zhenwangxue

自动画中心线，实用小程序！

wgamgzhang

看起来不错  喜欢 楼主真不错

chpmould

LZ还有待去完善...

chpmould

LZ还有待去完善,下面是我用的...

Votasee

总共没几行..直接贴贴得了...

1. ;;*************************;;
   
2. ;;CL.lsp:     
   
3. ;;Designed by pengliang  ;;
   
4. ;;2005.4.21;;
   
5. ;;*************************;;
   
6. 
   
7. (defun c:cl ()
   
8.    (setvar "cmdecho" 0)
   
9.    (setq os_old (getvar "osmode"))
   
10.    (setq cl_old (getvar "clayer"))
    
11.    (setvar "osmode" 0)
    
12.    (command "ucs" "")
    
13. ;-----------------------------------------------------------------------------------------
    
14.    (if (not (tblsearch "layer" "cen"))
    
15.        (command "_.layer" "_new" "cen" "_color" "1" "cen" "_ltype" "center" "cen" "")
    
16.        (command "_.layer" "thaw" "cen" "on" "cen" "unlock" "cen" "")
    
17.    )
    
18. ;------------------------------------------------------------------------------------------
    
19.   (setq a1 (entsel "\n请选定要画中心线的圆\\圆弧\\直线:"))
    
20.   (while (null a1)
    
21.        (setq a1 (entsel "\n请选定要画中心线的圆\\圆弧\\直线:"))
    
22.   )
    
23.   (setq a2 (entget (car a1)))
    
24.   (setq l1 (assoc 0 a2))
    
25.   (setq l2 (cdr l1))
    
26.   (while (and (/= l2 "LINE") (/= l2 "ARC") (/= l2 "CIRCLE"))
    
27.          (setq a1 (entsel "\n所选的不是圆\\圆弧\\直线:"))
    
28.          (while (null a1)
    
29.             (setq a1 (entsel "\n请选定要画中心线的圆\\圆弧\\直线:"))
    
30.          )
    
31.          (setq pt1 (cadr a1))
    
32.          (setq a2 (entget (car a1)))
    
33.          (setq l1 (assoc 0 a2))
    
34.          (setq l2 (cdr l1))
    
35.   )
    
36.   (if (or (= l2 "ARC") (= l2 "CIRCLE"))
    
37.       (progn
    
38.           (setq b1 (cdr (assoc 10 a2)))  ;圆心座标
    
39.           (setq b2 (cdr (assoc 40 a2)))  ;圆半径
    
40.           (setvar "clayer" "cen")
    
41.           (command "line" (list (- (car b1) (* b2 1.2)) (cadr b1)) (strcat "@" (rtos (* b2 2.4))
    
42.                           "<0") "")
    
43.           (command "array" "l" "" "p" b1 "2" "90" "")
    
44.       )
    
45.    )
    
46.   (if (or (= l2 "LINE"))
    
47.       (progn
    
48.           (setq a3 (entsel "\n请选定另一直线:"))
    
49.           (while (null a3)
    
50.                  (setq a3 (entsel "\n请选定另一直线:"))
    
51.           )
    
52.           (setq a4 (entget (car a3)))
    
53.           (setq end1 (cdr (assoc 10 a2)))
    
54.           (setq end2 (cdr (assoc 11 a2)))
    
55.           (setq end3 (cdr (assoc 10 a4)))
    
56.           (setq end4 (cdr (assoc 11 a4)))
    
57.           (setq e1 (distance end1 end3))
    
58.           (setq e2 (distance end1 end4))
    
59.           (if (< e1 e2)
    
60.              (progn
    
61.               (setq end5 (list (/ (+ (car end1) (car end3)) 2.0) (/ (+ (cadr end1) (cadr end3)) 2.0)))
    
62.               (setq end6 (list (/ (+ (car end2) (car end4)) 2.0) (/ (+ (cadr end2) (cadr end4)) 2.0)))
    
63.              )
    
64.              (progn
    
65.               (setq end5 (list (/ (+ (car end1) (car end4)) 2.0) (/ (+ (cadr end1) (cadr end4)) 2.0)))
    
66.               (setq end6 (list (/ (+ (car end2) (car end3)) 2.0) (/ (+ (cadr end2) (cadr end3)) 2.0)))
    
67.              )
    
68.           )
    
69.           (setq end5_1 (polar end5 (angle end6 end5) 10))
    
70.           (setq end6_1 (polar end6 (angle end5 end6) 10))
    
71.           (setvar "clayer" "cen")
    
72.           (command "line" end5_1 end6_1 "")
    
73.       )
    
74.    )
    
75.    (setvar "osmode" os_old)
    
76.    (setvar "clayer" cl_old)
    
77.    (princ)
    
78. )

复制代码

26712259

能不能写一个自动识别螺丝孔的,,,

84596534

看起来不错  喜欢 楼主真不错