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

本帖最后由 jh1005 于 2024-2-1 17:22 编辑

画多段线投影线 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 于 2018-2-14 04:40 编辑

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

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

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

网友答: 试用了，好用，好程序！

网友答: 感谢分享程序,感谢 jh1005 楼主!

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

网友答:

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

网友答: 那个50应该动态线长

网友答:

网友答: 有创意，赞一个。

网友答: 建议加捕捉！~~

上一篇：@lisp函数库，开源、云加载、易维护。实时查看函

下一篇：没有了