偏差箭头LISP

MaT02 · 发表于 2022-7-5 15:19:26

你好
我是论坛新手，
我想请你帮忙。我需要一个程序/应用程序（LISP），它将插入一个偏差省道和一个点到一条直线的距离。更具体地说，我想标记测量点和设计线，以表明其与项目的偏差。我试着自己写些东西，但对我来说太复杂了。
箭头应显示执行偏离设计的方向，最好根据图纸单独确定其长度。
在这张照片中，我展示了我的意思。
提前感谢您的帮助
当做

BIGAL · 发表于 2022-7-5 15:28:27

94人已经看到了这一点，像我一样不太明白你想要什么。比较设计点和竣工是很常见的，但你们的图片并没有给出任何线索。

MaT02 · 发表于 2022-7-5 15:36:13

对不起，也许我没有准确地表达我的想法。我有一个大地测量点，我想显示它与投影线的偏差。这就是我想用箭头的原因。
我有一个程序，在选择一个测量点和一条直线上的一个点插入一个箭头后，问题是当点接近一条直线时，箭头很小，我希望程序插入一个固定长度的箭头（前面定义的，例如0.2个单位），并在图形中以文本形式另外给出点到直线的距离（mm）。
箭头2.lsp

hanhphuc · 发表于 2022-7-5 15:39:37

另一个

copy


[color="green"]
;with minimum size [/color]
(defun _arrow ( pt p1 [color="red"]h[/color] / d sz)
 (setq sz (distance pt p1))
 (vla-put-ArrowheadSize
   (vlax-ename->vla-object
     (entmakex (list '(0 . "LEADER")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbLeader")
                     '(73 . 3)
                     '(8 . "ARROW")
                     (cons 10 p1)
                     (cons 10 (polar p1 (angle p1 pt) (setq sz (cond ((< sz h ) h) (sz)))))
                     )
               )
     )
   (/ sz  3.0 )
   )
 )
(vl-load-com)

copy


(defun c:test ( / p1 p2 )
(and
(setq p1 (getpoint "\nSpecify point 1: "))
(setq p2 (getpoint p1 "\nSpecify point 2: "))
(_arrow p1 p2 [b][color="red"]3.0[/color][/b]) [color="green"]; minimum size = 3.0 [/color]
)
(princ)
)

BIGAL · 发表于 2022-7-5 15:47:41

稍后，使用与刚刚用完的电池接近的点可能是有用的。当我开始充电时，我知道它需要两个答案，一个大的和一个小的，所以在里面画箭头或标签作为一个非常小的外部箭头。

copy


(vl-load-com)
; code by BIGAL
(defun c:test ( / pt1 pt2  diff x1 x2 y1 y2 xdiff ydiff obj)
(setq obj (vlax-ename->vla-object (car (entsel "\nPick line pline or arc etc"))))
(setq pt1 (getpoint "pick point"))
(setq pt2 (vlax-curve-getclosestpointto obj pt1))
(setq  ang (angle pt1 pt2))
(setq diff (distance pt1 pt2))
(setq x1 (car pt1) y1 (cadr pt1))
(setq x2 (car pt2) y2 (cadr pt2))
(setq xdiff (- x1 x2))
(setq ydiff (- y1 y2))
(alert (strcat "Length is " (rtos diff 2 2) "\nX difference is " (rtos xdiff 2 2) "\nY difference is " (rtos ydiff 2 2)))
(if ( > diff 50)
(progn
(command  "dimaligned" pt2 pt1  pt1)
(setq obj (vlax-ename->vla-object (entlast)))
(vla-put-arrowhead1block obj "none")
)
(progn
(setq pt2 (polar pt1 ang 65))
(command  "dimaligned" pt2 pt1  pt1)
(setq obj (vlax-ename->vla-object (entlast)))
(vla-put-arrowhead1block obj "none")
(vla-put-TextOverride obj (rtos diff 2 2 ))
)
)
(princ)
)
(c:test)