社区 › Auto Lisp › 三维多边形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。
(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)
)

Lee Mac 发表于 2022-7-6 12:58:25

不错，艾伦

wizman 发表于 2022-7-6 13:04:05

良好的编码Cab

Lee Mac 发表于 2022-7-6 13:05:45

毫无疑问，弗洛波先生会再次提出要求。。。

flopo 发表于 2022-7-6 13:08:01

 
 
 
 
没有更多请求。。。。关于这个问题
谢谢，伙计们！

查看完整版本: 三维多边形lisp