距离最近Po的区块距离
正如标题所示，我正在寻找某种自动化程序，在那里我可以获得一个列表，详细说明从块到直线上最近点的距离。更详细地说，基于我需要它的目的，请阅读以下内容。
通常，我们有一条铁路轨道或一段公路（既有或拟建，这实际上不是该计划的考虑因素），在轨道两侧任意距离分布着钻孔和试坑。
现在，工程师们要求我提出一种生成报告的方法，该报告可以显示每个钻孔或试坑等（这些将是图纸中的块）距轨道上最近点（CAD中的二维或三维多段线）的距离。
如果有人能提供这种功能，我可能会有其他更复杂的要求，我的公司可能愿意在以后的某个时间进行补偿。不过，无法保证未来的工作。我现在能做的就是表示我的感激。 我设法为任何想四处嗅探的人找到了一个好榜样。
附图中有地形测量，顶部包含两条绿线，即铁路轨道。
红色符号（带两个三角形图案填充的圆形）是钻孔-从其中心到我们要测量的铁路轨道最近距离的块。这些块都在层上：建议-红色（以及它们的所有实体）。
理想情况下，我们需要一个程序，要求我们选择要从哪条线测量块，然后让每个块从其中心测量到该线上最近的点。
CADTutor。拉链 调整尺寸样式并分解块，包括测量平面：
(defun c:pdis(/ cCurve cBlock dPt1 dPt2)
(vl-load-com)
(if
(and
(setq cCurve(entsel "\nSelect curve to measure > "))
(member(cdr(assoc 0(entget(car cCurve))))
'("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE"))
); end and
(while
(and
(setq cBlock(entsel "\nSelect block or Esc to Quit > "))
(=(cdr(assoc 0(entget(car cBlock)))) "INSERT")
); end and
(progn
(setq dPt1(cdr(assoc 10(entget(car cBlock))))
dPt2(vlax-curve-getClosestPointTo (car cCurve) dPt1))
(vl-cmdf "_.dimaligned" (trans dPt1 0 1) (trans dPt2 0 1) pause)
); end progn
(princ "\n<!> Empty selection or this isn't block <!> ")
); end while
(princ "\n<!> Empty selection or this isn't curve (line, polyline, etc.) <!> ")
); end if
(princ)
); end of c:pdis 嗨，阿斯米，
我看着这个问题，心里想。。。我该怎么做。
然后用一个漂亮的代码提供答案。
但我看了一下代码，看到您使用了这个函数：
vlax曲线getClosestPointTo
这似乎是一个非常方便的功能
但是，由于我不知道如何很好地使用Visual LISP，我不知道您是否首先需要使用：
vlax ename->vla对象
第一
为什么会这样？你什么时候要用上面的？ vlax曲线-函数与VLA对象的工作方式相同，与ENAME but demands（vl load com）的工作方式相同。 在普通AutoLISP中，需要更多的代码。
;=======================================================================
; ClosePT.Lsp Jan 08, 2009
; Find Thge Closest Point From An INSERT to a PATH - 2D
;================== Start Program ======================================
(princ "\nCopyright (C) 1990-2009, Fabricated Designs, Inc.")
(princ "\nLoading ClosePT v1.0")
(setq cpt_ nil lsp_file "ClosePT")
;++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun cpt_smd ()
(SetUndo)
(setq olderr *error*
*error* (lambda (e)
(while (> (getvar "CMDACTIVE") 0)
(command))
(and (/= e "quit / exit abort")
(princ (strcat "\nError: *** " e " *** ")))
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END" "_.U"))
(cpt_rmd))
cpt_var '(("CMDECHO" . 0) ("MENUECHO" . 0)
("MENUCTL" . 0) ("MACROTRACE" . 0)
("OSMODE" . 0) ("SORTENTS" . 119)
("LUPREC" . 2)
("BLIPMODE". 0) ("EXPERT" . 0)
("SNAPMODE". 1) ("PLINEWID" . 0)
("ORTHOMODE" . 1) ("GRIDMODE" . 0)
("ELEVATION" . 0) ("THICKNESS". 0)
("COORDS" . 2) ("UCSICON" . 1)
("HIGHLIGHT" . 1) ("REGENMODE". 1)
("CECOLOR" . "BYLAYER")
("CELTYPE" . "BYLAYER")))
(foreach v cpt_var
(and (getvar (car v))
(setq cpt_rst (cons (cons (car v) (getvar (car v))) cpt_rst))
(setvar (car v) (cdr v))))
(princ (strcat (getvar "PLATFORM") " Release " (ver)))
(princ))
;++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun cpt_rmd ()
(setq *error* olderr)
(foreach v cpt_rst (setvar (car v) (cdr v)))
(command "_.UNDO" "_END")
(prin1))
;++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
(command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
(command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))
;;;++++++++++ 2D Is Point On ARC ++++++++++++++++++++++++++++++++++++++
;;;ARG -> ARC_EnameTestPointFuzz
;;;RET -> T nil
(defun is_pt_on_arc (en tp fz / ed ce ra sa ea ta)
(setq ed (entget en)
ce (p2d (cdr (assoc 10 ed)))
ra (cdr (assoc 40 ed))
sa (cdr (assoc 50 ed))
ea (cdr (assoc 51 ed))
ta (angle ce tp)
tp (p2d tp))
(and (equal (distance ce tp) ra fz)
(if (> sa ea)
(or (>= ta sa)
(<= ta ea))
(and (<= ta ea)
(>= ta sa)))))
;;;++++++++++ 2D Intersections Of Line & Arc ( Circle ) ++++++++++++++++
;;;ARG -> LINE_ename ARC_ename ( CIRCLE or ARC )
;;;RET -> nil or List_Of_Points
;;;ERROR = None
(defun inter_line_arc (l10 l11 arc / a10 rad ip1 ip2)
(setq l10 (p2d l10)
l11 (p2d l11)
a10 (p2d (cdr (assoc 10 (entget arc))))
rad (cdr (assoc 40 (entget arc)))
ip1 (polar a10 (angle l10 l11) rad)
ip2 (polar a10 (angle l11 l10) rad))
(cond ((is_pt_on_arc arc ip1 1e-
ip1)
((is_pt_on_arc arc ip2 1e-
ip2)))
;;;FIND CLOSEST POINT TO LINE FORM GIVEN POINT
;;;ARG -> POINT LINE_ENAME
;;;RET -> POINT
(defun find_near_line (p l / ld l10 l11 tp)
(setq ld (entget l)
l10 (p2d (cdr (assoc 10 ld)))
l11 (p2d (cdr (assoc 11 ld)))
p (p2d p))
(cond ((setq tp (inters l10 l11
p (polar p (+ (angle l10 l11) (* pi 0.5)) 1))))
((if (< (distance p l10)
(distance p l11))
(setq tp l10)
(setq tp l11))))
tp)
;************ Main Program ***************************************
(defun cpt_ (/ olderr cpt_var cpt_rst ss bn bp ls pn pd pf fe fd pc ts
cp np p2d)
(cpt_smd)
(setq p2d (lambda (p) (list (car p) (cadr p))))
(while (or (not ss)
(> (sslength ss) 1))
(princ "\nSelect Block To Test: ")
(setq ss (ssget (list (cons 0 "INSERT")
(if (getvar "CTAB")
(cons 410 (getvar "CTAB"))
(cons 67 (- 1 (getvar "TILEMODE"))))))))
(setq bn (ssname ss 0)
bp (p2d (trans (cdr (assoc 10 (entget bn))) bn 0)))
(while (or (not ls)
(> (sslength ls) 1))
(princ "\nSelect Path To Test: ")
(setq ls (ssget (list (cons 0 "LINE,*POLYLINE")
(if (getvar "CTAB")
(cons 410 (getvar "CTAB"))
(cons 67 (- 1 (getvar "TILEMODE")))))))
(and ls
(setq pn (ssname ls 0)
pd (entget pn)
pf (cdr (assoc 70 pd)))
(= "POLYLINE" (cdr (assoc 0 pd)))
(> pf 15)
(princ "\nPOLYLINE MESHES CANNOT BE USED")
(setq ls nil)))
(command "_.COPY" pn "" '(0 0 0) '(0 0 0))
(setq pc (entlast) fe pc)
(command "_.EXPLODE" pc)
(setq fe (entnext fe)
ts (ssadd))
(while fe
(ssadd fe ts)
(setq fd (entget fe))
(cond ((= "LINE" (cdr (assoc 0 fd)))
(setq np (find_near_line bp fe)))
((= "ARC" (cdr (assoc 0 fd)))
(setq np (inter_line_arc bp (cdr (assoc 10 fd)) fe))))
(cond ((not np))
((not cp)
(setq cp np))
(T
(setq cp (if (> (distance cp bp)
(distance np bp))
np cp))))
(setq fe (entnext fe)))
(command "_.ERASE" pc ts "")
(redraw)
(princ "\nClosest Point in 2D From Block To Path Is ")
(prin1 cp)
(cpt_rmd))
;************ Load Program ***************************************
(defun C:ClosePT () (cpt_))
(if cpt_ (princ "\nClosePT Loaded\n"))
(prin1)
;|================== End Program =======================================
原样-David 天哪，大卫，我明白他们为什么引入VL！。。。
很好的代码-你已经有了，还是刚刚键入了？。。。
阿斯米，谢谢你的建议——我知道我使用的每个vlax曲线函数都只需要一个ename（在vl load com之后），并且我不必经历尝试转换它的过程，我安全吗。。 >大卫·本特尔
为什么这个萨满要和u一起跳舞。爆炸，_。如果存在vlax curve GetClosestPointTo和vlax curve GetClosestPointToProjection（用于3D）函数，则撤消？
我尊重你作为程序员，也尊重LISP作为语言，但有点不理解你对ActiveX编程的厌恶
哈哈，如果可能的话，我尽量避免活动X。。。。我很害怕 阿斯米，你能详细解释一下你的最后一篇文章吗，关于我需要如何使用LISP例程以及它到底做什么？
所示的示例图具有用于官方用途的各种调查比例和化身的昏暗样式和相关用具。
为每一位对此帖子做出贡献的人干杯。
页:
[1]
2