洪少(刀模) 发表于 2017-12-12 08:48:07

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

xujinhua 发表于 2017-12-13 08:31:20

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

cyfdean 发表于 2018-2-1 14:23:30

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

yeple 发表于 2018-2-2 14:21:44

圆好像不行！！

greg.battin 发表于 2018-2-14 04:36:56

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)

Nico 发表于 2018-5-2 09:09:25

牛B，好东西

二更更二 发表于 2018-5-3 19:13:42

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

paulpipi 发表于 2018-5-13 13:22:08

有创意，赞一个。

二更更二 发表于 2018-5-27 22:28:19

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

希望的田野 发表于 2019-5-22 14:52:28

不错很好用谢谢楼主！
页: 1 2 3 4 5 [6] 7 8 9 10
查看完整版本: 画多段线投影线 v1.2(2024-2-1更新)