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

jh1005

画多段线投影线 v1.2(2024-2-1更新)
1.增加选择：圆、椭圆
2.修正长度不能为小数的bug


画多段线投影线 v1.1(2016-8-6更新)
增加多选，遮挡线，外框生成为矩形。


程序使用射线法求出四个方向的点，有点像光线照射一样，射线和多段线有2个交点以上的视为看不到的点，否则为看得到的点。长度单位mm，密度为铝合金密度(2.71)可自行修改。
此程序适合画一些铝合金的简单的加工图，省去画三维的麻烦。

画多段线投影线 v1.2

画多段线投影线 v1.1

画多段线投影线 v1.0

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)

yangchao2005090

非常感谢楼主的好程序，我用了一下好像圆跟椭圆这种单一形状的投影不出来，如果能加进去就完美了

q3_2006

没画对呀！

q3_2006

试用了，好用，好程序！

yoyoho

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

669423907

谢谢楼主分享有趣的程序，但侧视图有些是虚线，得手动改

emk

哇，刚上来就看见好程序，支持楼主，谢谢

429014673

那个50应该动态线长

xhq1954425

dwg001

有创意，赞一个。

daidong013

建议加捕捉！~~