画多段线投影线 v1.2(2024-2-1更新)
本帖最后由 jh1005 于 2024-2-1 17:22 编辑画多段线投影线 v1.2(2024-2-1更新)
1.增加选择：圆、椭圆
2.修正长度不能为小数的bug
static/image/hrline/1.gif
画多段线投影线 v1.1(2016-8-6更新)
增加多选，遮挡线，外框生成为矩形。
static/image/hrline/1.gif
程序使用射线法求出四个方向的点，有点像光线照射一样，射线和多段线有2个交点以上的视为看不到的点，否则为看得到的点。长度单位mm，密度为铝合金密度(2.71)可自行修改。
此程序适合画一些铝合金的简单的加工图，省去画三维的麻烦。
画多段线投影线 v1.2
画多段线投影线 v1.1
画多段线投影线 v1.0
RE: 画多段线投影线 v1.1(2016-8-6更新)
本帖最后由 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)
(setqosm(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 : "))
(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 : "))
(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 cont10
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应该动态线长 有创意，赞一个。 建议加捕捉！~~