三维多边形lisp

alanjt · 发表于 2022-7-6 12:39:37

这是当之无愧的，我甚至从来没有研究过closestpointtoprojection。

flopo · 发表于 2022-7-6 12:43:36

大家好，
在从点到三维多边形绘制垂直线之后，我必须测量连续交点三维多边形-垂直线之间的距离。Lisp程序这样做会帮我很多。。。见附件-图纸。谢谢
3dpoly-dist.dwg

CAB · 发表于 2022-7-6 12:45:58

试试这个：（李的例行修改）

(defun c:perp (/ i ss ent pt p1 p2)
 (vl-load-com)
 (command "_undo" "_begin")
 (princ "\n>> Select Points >>")
 (if (setq i  -1
           ss (ssget '((0 . "POINT"))) )
   (if (and (setq ent (car (entsel "\nSelect Curve: ")))
            (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,CIRCLE,ELLIPSE,ARC"))
     (while (setq pt (ssname ss (setq i (1+ i))))
       (setq
         p2 (vlax-curve-getClosestPointto ent (setq p1 (cdr (assoc 10 (entget pt)))))
       )
       (if (entmake (list '(0 . "LINE") '(8 . "perp") (cons 10 p1) (cons 11 p2)))
         (entmake
           (list '(0 . "MTEXT")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbMText")
                 '(8 . "point")
                 (cons 10 p1)
                 '(40 . 0.6)
                 '(41 . 6.03584)
                 '(71 . 1)
                 '(72 . 5)
                 (cons 1 (vl-princ-to-string (distance p1 p2)))
                 '(7 . "Standard")
                             ;'(210 0.0 0.0 1.0)
                 '(42 . 1.6)
                 '(43 . 0.6)
                 '(50 . 0.0)
                 '(73 . 1)
                 '(44 . 1.0)
           )
         )
       )
     )
   )
 )
 (command "_undo" "_end")
 (princ)
)

CAB · 发表于 2022-7-6 12:50:12

要跟上此线程，您应该查看以下内容：
http://cadtutor.net/forum/showthread.php?t=42442

以下是您的解决方案：
http://cadtutor.net/forum/showpost.php?p=286596&postcount=13

http://cadtutor.net/forum/showthread.php?t=42505

http://www.theswamp.org/index.php?topic=31120.0
http://www.theswamp.org/index.php?topic=31110.0

http://discussion.autodesk.com/forums/thread.jspa?messageID=6296446
http://discussion.autodesk.com/forums/thread.jspa?threadID=753908&tstart=0

wizman · 发表于 2022-7-6 12:53:45

很好的代码Cab，但我认为他是在沿着3dpoly的距离。

CAB · 发表于 2022-7-6 12:57:15

哎呀，谢谢Wizman。

copy

(defun c:perp (/ i ss ent pt p1 p2 ptList LASTPT)
 (vl-load-com)
 (command "_undo" "_begin")
 (princ "\n>> Select Points >>")
 (if (setq i  -1
           ss (ssget '((0 . "POINT"))) )
   (if (and (setq ent (car (entsel "\nSelect Curve: ")))
            (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,CIRCLE,ELLIPSE,ARC"))
     (while (setq pt (ssname ss (setq i (1+ i))))
       (setq p2 (vlax-curve-getClosestPointto ent (setq p1 (cdr (assoc 10 (entget pt))))))
       (setq ptList (cons p2 ptList))
       (entmake (list '(0 . "LINE") '(8 . "perp") (cons 10 p1) (cons 11 p2)))
     )
   )
 )
 (if ptList
   (progn
     (setq Startpt (vlax-curve-getstartpoint ent)
           Lastpt Startpt)
     ;;  sort by distance
     (setq ptList (vl-sort ptList '(lambda (e1 e2)
                                     (< (vlax-curve-getdistatpoint ent e1)
                                        (vlax-curve-getdistatpoint ent e2)))))
   (foreach pt ptList
     (if (> (distance pt Startpt) 0.001)
         (entmake
           (list '(0 . "MTEXT")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbMText")
                 '(8 . "point")
                 (cons 10 (polar pt (angle pt Lastpt)(/ (distance pt Lastpt) 2.)))
                 '(40 . 0.6)
                 '(41 . 0.0)
                 '(71 . 
                 '(72 . 5)
                 (cons 1 (rtos (distance pt Lastpt) 2 2))
                 '(7 . "Standard")
                             ;'(210 0.0 0.0 1.0)
                 '(50 . 0.0)
                 '(73 . 1)
                 '(44 . 1.0)
           )
         )
       )
      (setq LastPt pt)
     )
   )
 )
 
 (command "_undo" "_end")
 (princ)
)