画多段线投影线 v1.2(2024-2-1更新)

洪少(刀模)

非常好用，能加上孔位就好了

xujinhua

厉害。。。。谢谢楼主，下载来备用

cyfdean

感谢分享程序,感谢 jh1005 楼主!

yeple

圆好像不行！！

greg.battin

here is one that lets you define a line that points are to be projected upon.

1. ;project lines - GREAT FOR CREATING ELEVATIONS
   
2. (defun pt?  (pt)
   
3.   (and (vl-consp pt)
   
4.        (= (length pt) 3)
   
5.        (vl-every (function (lambda (coord) (= (type coord) 'real)))
   
6.      pt)))
   
7. 
   
8. (defun C:PROJECT  (/ osm cmd orth p1 p2 p3 p4 Lb sslp lth cont cont1)
   
9.   (setq  osm  (getvar "OSMODE")
   
10.   cmd  (getvar "CMDECHO")
    
11.   orth (getvar "ORTHOMODE")
    
12.   sslp (ssadd))
    
13.   (setvar "CMDECHO" 0)
    
14.   (setvar "ORTHOMODE" 1)
    
15.   (setvar "OSMODE" 0)
    
16.   (if (and (setq p1 (getpoint "\nFirst point: "))
    
17.      (setq p2 (getpoint "\nSecond point: " p1)))
    
18.     (progn
    
19. 
    
20.       (command "_.LINE" p1 p2 "")
    
21.       (setq L (entlast))
    
22.       (redraw (entlast) 3)
    
23.       (setvar "OSMODE" 33)
    
24. 
    
25.       (initget "Erase")
    
26.       (setq p3 (getpoint "\n<Enter to exit>/Select point [Erase]: "))
    
27. 
    
28.       (if (pt? p3)
    
29.   (progn
    
30.     (setvar "OSMODE" 0)
    
31.     (setq p4 (polar p3 (+ (angle p1 p2) (/ pi 2)) 1))
    
32.     (command "_.LINE" p3 (inters p1 p2 p3 p4 nil) "")
    
33.     (redraw (entlast) 3)
    
34.     (setq sslp (ssadd (entlast) sslp))
    
35.     (setvar "OSMODE" 33)))
    
36. 
    
37.       (while (or (pt? p3) (= p3 "Erase"))
    
38.   (initget "Erase")
    
39.   (setq p3
    
40.          (getpoint "\n<Enter to exit>/Select point [Erase]: "))
    
41.   (if (pt? p3)
    
42.     (progn
    
43.       (setvar "OSMODE" 0)
    
44.       (setq p4 (polar p3 (+ (angle p1 p2) (/ pi 2)) 1))
    
45.       (command "_.LINE" p3 (inters p1 p2 p3 p4 nil) "")
    
46.       (redraw (entlast) 3)
    
47.       (setq sslp (ssadd (entlast) sslp))
    
48.       (setvar "OSMODE" 33)))
    
49.   (if (and (= p3 "Erase") (ssname sslp 0))
    
50.     (progn
    
51.       (prompt "\nSelect projection line(s)")
    
52.       (setq cont1  0
    
53.       lb  (ssget))
    
54.       (setq cont 0
    
55.       lth  (sslength lb))
    
56.       (while (<= cont (- lth 1))
    
57.         (if (ssmemb (ssname Lb cont) sslp)
    
58.     (progn
    
59.       (ssdel (ssname Lb cont) sslp)
    
60.       (command "_.ERASE" (ssname Lb cont) "")         (setq account (1+ cont)))
    
61.       (setq cont1 (1+ cont1)))))
    
62. 
    
63.       (prompt (strcat (itoa lth)
    
64.           " Selected object(s)), "
    
65.           (itoa cont1)
    
66.           " Projection line(s) erased"))))
    
67.   (if (and (= p3 "Erase") (null (ssname sslp 0)))
    
68.     (prompt "\nProjection line(s) not found to erase")))
    
69.       (setvar "OSMODE" osm)
    
70.       (setvar "ORTHOMODE" orth)
    
71.       (if (ssname sslp 0)
    
72.   nil
    
73.   (command "_.ERASE" L ""))))
    
74.   (setvar "CMDECHO" cmd)
    
75.   (princ))
    
76. (princ)

;project lines - GREAT FOR CREATING ELEVATIONS<br /> (defun pt?  (pt)<br />   (and (vl-consp pt)<br />        (= (length pt) 3)<br />        (vl-every (function (lambda (coord) (= (type coord) 'real)))<br />      pt)))<br /> <br /> (defun C:PROJECT  (/ osm cmd orth p1 p2 p3 p4 Lb sslp lth cont cont1)<br />   (setq  osm  (getvar "OSMODE")<br />   cmd  (getvar "CMDECHO")<br />   orth (getvar "ORTHOMODE")<br />   sslp (ssadd))<br />   (setvar "CMDECHO" 0)<br />   (setvar "ORTHOMODE" 1)<br />   (setvar "OSMODE" 0)<br />   (if (and (setq p1 (getpoint "\nFirst point: "))<br />      (setq p2 (getpoint "\nSecond point: " p1)))<br />     (progn<br /> <br />       (command "_.LINE" p1 p2 "")<br />       (setq L (entlast))<br />       (redraw (entlast) 3)<br />       (setvar "OSMODE" 33)<br /> <br />       (initget "Erase")<br />       (setq p3 (getpoint "\n<Enter to exit>/Select point [Erase]: "))<br /> <br />       (if (pt? p3)<br />   (progn<br />     (setvar "OSMODE" 0)<br />     (setq p4 (polar p3 (+ (angle p1 p2) (/ pi 2)) 1))<br />     (command "_.LINE" p3 (inters p1 p2 p3 p4 nil) "")<br />     (redraw (entlast) 3)<br />     (setq sslp (ssadd (entlast) sslp))<br />     (setvar "OSMODE" 33)))<br /> <br />       (while (or (pt? p3) (= p3 "Erase"))<br />   (initget "Erase")<br />   (setq p3<br />          (getpoint "\n<Enter to exit>/Select point [Erase]: "))<br />   (if (pt? p3)<br />     (progn<br />       (setvar "OSMODE" 0)<br />       (setq p4 (polar p3 (+ (angle p1 p2) (/ pi 2)) 1))<br />       (command "_.LINE" p3 (inters p1 p2 p3 p4 nil) "")<br />       (redraw (entlast) 3)<br />       (setq sslp (ssadd (entlast) sslp))<br />       (setvar "OSMODE" 33)))<br />   (if (and (= p3 "Erase") (ssname sslp 0))<br />     (progn<br />       (prompt "\nSelect projection line(s)")<br />       (setq cont1  0<br />       lb  (ssget))<br />       (setq cont 0<br />       lth  (sslength lb))<br />       (while (<= cont (- lth 1))<br />         (if (ssmemb (ssname Lb cont) sslp)<br />     (progn<br />       (ssdel (ssname Lb cont) sslp)<br />       (command "_.ERASE" (ssname Lb cont) "")         (setq account (1+ cont)))<br />       (setq cont1 (1+ cont1)))))<br /> <br />       (prompt (strcat (itoa lth)<br />           " Selected object(s)), "<br />           (itoa cont1)<br />           " Projection line(s) erased"))))<br />   (if (and (= p3 "Erase") (null (ssname sslp 0)))<br />     (prompt "\nProjection line(s) not found to erase")))<br />       (setvar "OSMODE" osm)<br />       (setvar "ORTHOMODE" orth)<br />       (if (ssname sslp 0)<br />   nil<br />   (command "_.ERASE" L ""))))<br />   (setvar "CMDECHO" cmd)<br />   (princ))<br /> (princ)

Nico

牛B，好东西

二更更二

只能多段线吗，楼主开发个直线的么！应该很有用！

paulpipi

有创意，赞一个。

二更更二

能支持直线吧？平时很少多断线啊

希望的田野

不错很好用谢谢楼主！