erbalaji 发表于 2022-7-5 15:39:14

点的垂直线

你好,工程师们
关于在两条线之间进行测量,我希望得到您的帮助。
我的要求是
在1m处生成点
从其基准位置生成垂直线
一直延伸到品红线
给出线路长度。
你们能帮帮我吗?
请看附件。
非常感谢。

BIGAL 发表于 2022-7-5 15:58:33

这在土木工程中称为Peg&shift。代码非常简单,只是检查了一些我有的东西。
 
试试这个,这是一个开始。如果你想让它全尺寸等等,那么这是一个更大的任务。
 

; simple peg & shift at constant distance
; By Alan H Jan 2018

(defun chktstyle ( /)
(setqdoc (vla-get-activedocument (vlax-get-acad-object)))
(setq cursty (getvar "textstyle"))
(setq stys (vla-get-textstyles doc))
(vlax-for sty stys
(if (= cursty (vla-get-name sty))
(setq ht (vla-get-height sty))
)
(if (and (/= ht nil)(> ht 0.0))(setq tsy "Y")(setq ht 2.5))
)
)

(defun pegoff ( / len len2 newpt ang ht)
(setq newPt (vlax-curve-getClosestPointTo Obj2 Pt))
(setq len2 (distance newpt pt))
(setq ang (angle newpt pt))
(command "line" newpt pt "")
(chktstyle)
(if (= tsy "Y")
(command "Text" pt ang (rtos len2 2 2))
(command "Text" pt ht ang (rtos len2 2 2))
)

;(alert (strcat "The ch is " (rtos ch 2 2) "\n\nOffset is " (rtos len2 2 2))) ; dummy to see something
)

(defun pegsh ( / obj obj2 lstch num olen inc)
(setq obj   (vlax-ename->vla-object (car (entsel "\nPick peg line"   ))))
(setq obj2 (vlax-ename->vla-object (car (entsel "\nPick offset line"))))

(setq olen (vla-get-length obj))

(setq inc (getreal "\nEnter your increment"))
(setq num (fix (/ olen inc)))
(setq lstch (list 0.0)) ; accept 1st pointc
(setq ch 0.0)
(repeat num
(setq lstch (cons (setq ch (+ ch inc)) lstch))
)
(setq lstch (cons olen lstch))


(repeat (setq x (length lstch))
(setq ch (nth (setq x (- x 1)) lstch))
(setq pt (vlax-curve-getpointatdist obj ch))
(pegoff)
)

) ;defun pegsh

(setq oldsnap (getvar 'osmode))
(SETQ ANGBASEE (GETVAR "ANGBASE"))
(SETQ ANGDIRR (GETVAR "ANGDIR"))
(SETQ AUNITSS (GETVAR "AUNITS"))
(setq luprecc (GETVAR "LUPREC" ))
(SETVAR "ANGBASE" 0.0)
(SETVAR "ANGDIR" 0)
(SETVAR "LUPREC" 3)
(SETVAR "AUNITS" 3)
(setvar 'osmode 0)
(pegsh)
(setvar 'osmode oldsnap)
(SETVAR "ANGBASE" angbasee)
(SETVAR "ANGDIR" angdirr)
(SETVAR "LUPREC" luprecc)
(SETVAR "AUNITS" aunitss)

erbalaji 发表于 2022-7-5 16:08:38

非常感谢Bigul
我希望将值保留在行的末尾或开头,而不是显示在窗口中
无需标注尺寸。
你能修改这个lisp吗?
非常感谢

BIGAL 发表于 2022-7-5 16:17:33

张贴你想要的图片。

erbalaji 发表于 2022-7-5 16:31:59

请看这张图片
 

BIGAL 发表于 2022-7-5 16:41:13

上面的代码已经更新,我将留给你发挥确切的文字位置,也不是它希望文字风格有高度设置。将文本ht修正为零,您可能需要更改2.5。
页: [1]
查看完整版本: 点的垂直线