三维多边形lisp

flopo · 发表于 2022-7-6 12:07:14

大家好，
我正在处理三维多段线，我需要一个lisp来完成这项工作：从垂直于三维多段线的一些点绘制直线。有很多点，3d点-我是指空间中的点，Z不同于0。从每个点绘制一条垂直于三维多段线的垂线，但在距离我的点更近的那部分多边形上。有可能吗？谢谢

flopo · 发表于 2022-7-6 12:11:57

这是一个示例，但遗憾的是，我没有包含三维多段线的图形，只有二维多段线。原始三维铺层已被展平，是一个管道，无论如何，Z轴上的差异很小。。。
多段线。图纸

SEANT · 发表于 2022-7-6 12:16:00

这篇文章探讨了相同的主题。有一些优秀的lisp示例（从第26页开始），它们不需要太多修改就可以完成请求的任务。

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

Lee Mac · 发表于 2022-7-6 12:18:28

试试这个：

copy


(defun c:perp (/ i ss ent pt p1 p2)
 (vl-load-com)
 (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))))))
         (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))))
 
 (princ))

alanjt · 发表于 2022-7-6 12:21:15

嘿，我用了一些很类似的东西。

copy

;;; Draw line perpendicular from selected curve
;;; Required Subroutines: AT:Entsel
;;; Alan J. Thompson, 09.29.09
(defun c:LPer (/ *error* #Ent #Obj #Point)
 (setq *error* (lambda (x) (and #Obj (vl-catch-all-apply 'vla-highlight (list #Obj :vlax-false)))))
 (and
   (setq #Ent (AT:Entsel nil "\nSelect curve: " '((0 . "*POLYLINE,ARC,LINE,CIRCLE,ELLIPSE")) nil))
   (setq #Obj (vlax-ename->vla-object (car #Ent)))
   (not (vla-highlight #Obj :vlax-true))
   (while (setq #Point (getpoint "\nSpecify point for line: "))
     (entmake (list '(0 . "LINE")
                    (cons 10 (vlax-curve-getclosestpointto (car #Ent) (trans #Point 1 0) T))
                    (cons 11 (trans #Point 1 0))
              ) ;_ list
     ) ;_ entmake
   ) ;_ while
 ) ;_ and
 (*error* nil)
 (princ)
) ;_ defun

唯一的问题是，使用3DPolyline时，顶点高程将导致导出最近点。它通常会突然到达终点或其他地方。这真的很烦人。这就是为什么在试图获取三维多段线上的点时，必须使用（osnap（cadr ent）“_near”）而不是（vlax curve getclosestpointto（car ent）（cadr ent））。

Lee Mac · 发表于 2022-7-6 12:26:03

快速测试似乎可以，但我并不反对你，因为我在3D世界的经验确实有限眨眼：

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

它把它们画到了一条线上，它们只是在俯视图中不垂直（根据我的经验，这就是你想要的）。然而，请求方可能只是询问您所做的事情。在处理3D世界时很棘手。我是一个文明的人，所有的东西都是3D的，但不是以一些人在3D中工作的方式。我仍然生活在一个俯瞰世界的地方。

Lee Mac · 发表于 2022-7-6 12:29:55

说到这里，这个怎么样？

copy


(defun c:perp (/ i ss ent pt p1 p2)
 (vl-load-com)
 (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-getClosestPointtoprojection ent
                    (setq p1 (cdr (assoc 10 (entget pt)))) '(0 0 1)))
         (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))))
 
 (princ))

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

干得好，李！

我也更新了我的。

copy

;;; Draw line perpendicular from selected curve
;;; Required Subroutines: AT:Entsel
;;; Alan J. Thompson, 09.29.09
(defun c:LPer (/ *error* #Ent #Obj #Point)
 (setq *error* (lambda (x) (and #Obj (vl-catch-all-apply 'vla-highlight (list #Obj :vlax-false)))))
 (and
   (setq #Ent (AT:Entsel nil "\nSelect curve: " '((0 . "*POLYLINE,ARC,LINE,CIRCLE,ELLIPSE")) nil))
   (setq #Obj (vlax-ename->vla-object (car #Ent)))
   (not (vla-highlight #Obj :vlax-true))
   (while (setq #Point (getpoint "\nSpecify point for line: "))
     (entmake (list '(0 . "LINE")
                    (cons 10 (vlax-curve-getclosestpointtoprojection (car #Ent) (trans #Point 1 0) '(0 0 1)))
                    (cons 11 (trans #Point 1 0))
              ) ;_ list
     ) ;_ entmake
   ) ;_ while
 ) ;_ and
 (*error* nil)
 (princ)
) ;_ defun

Lee Mac · 发表于 2022-7-6 12:36:20

谢谢Alan

[编程交流] 三维多边形lisp

发表回复

精选推荐