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

三维多边形lisp

大家好，
我正在处理三维多段线，我需要一个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

试试这个：
 

(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

 
嘿，我用了一些很类似的东西。
;;; 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

说到这里，这个怎么样？
 

(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

 
 
干得好，李！
 
我也更新了我的。
 
;;; 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
页: [1] 2
查看完整版本: 三维多边形lisp