（求助）请教各位大神关于“生成直线阵列”看看能不能帮忙解决
求助一下各位大神们，有空的话，看能不能练练手，帮小弟解决一下以下功能：1.指定第一点：
2.指定第二点：
3.请输入直线的长度（带记忆）：100
4.请输入直线之间的间距（带记忆）：20
注：生成线为图层 Y7
生成的线垂直于鼠标两点
999999 发表于 2022-5-22 19:36
哈哈，你都从小白到大神了，我悟性比较低，大神，你帮忙看看，能不能让白线不超出两点 ...
小改即可，嘿嘿....
(defun C:NM (/ p1 p1d p2 ps ps1 ps2)
(setq p1 (getpoint "\n第一点:"))
(setq p2 (getpoint "\n第二点:" p1))
(or *dchangdu* (setq *dchangdu* 1))
(setq*dchangdu* (if (setq odchangdu(getdist(strcat "\r请输入直线长度<" (rtos *dchangdu*) ">:")))
odchangdu
*dchangdu*
)
)
(or *djianju* (setq *djianju* 1))
(setq*djianju* (if (setq odjianju(getdist(strcat "\r请输入间距<" (rtos *djianju*) ">:")))
odjianju
*djianju*
)
)
(setq cishu(atoi(rtos(-(/(distance p1 p2)*djianju*)0.5)2 0)))
(setq p1d p1)
(setq ang(angle p1d p2))
(repeat cishu
(setq ps(polar p1 (angle p1d p2)*djianju*))
(setq ps1(polar ps (+ ang(* 0.5 pi))(* 0.5 *dchangdu*)))
(setq ps2(polar ps (+ ang(* 1.5 pi))(* 0.5 *dchangdu*)))
(entmake (list '(0 . "LINE") (cons 10 ps1) (cons 11 ps2)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "Y7")
(setq p1 ps)
)
(princ)
) 本帖最后由 xj6019 于 2022-5-22 18:21 编辑
(defun C:NM (/ p1 p1d p2 ps ps1 ps2 ang)
(setq p1 (getpoint "\n第一点:"))
(setq p2 (getpoint "\n第二点:" p1))
(or *dchangdu* (setq *dchangdu* 1))
(setq*dchangdu* (if (setq odchangdu(getdist(strcat "\r请输入直线长度<" (rtos *dchangdu*) ">:")))
odchangdu
*dchangdu*
)
)
(or *djianju* (setq *djianju* 1))
(setq*djianju* (if (setq odjianju(getdist(strcat "\r请输入间距<" (rtos *djianju*) ">:")))
odjianju
*djianju*
)
)
(setq cishu(atoi(rtos(/(distance p1 p2)*djianju*)2 0)))
(setq p1d p1)
(setq ang(angle p1d p2))
(repeat cishu
(setq ps(polar p1 (angle p1d p2)*djianju*))
(setq ps1(polar ps (+ ang(* 0.5 pi))(* 0.5 *dchangdu*)))
(setq ps2(polar ps (+ ang(* 1.5 pi))(* 0.5 *dchangdu*)))
(entmake (list '(0 . "LINE") (cons 10 ps1) (cons 11 ps2)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "Y7")
(setq p1 ps)
)
(princ)
)
xj6019 发表于 2022-5-22 17:45
(defun C:NM (/ p1 p1d p2 ps ps1 ps2 ang)
(setq p1 (getpoint "\n第一点:"))
(se ...
这种简单的你自己凑凑应该是可以拼起来的吧 xj6019 发表于 2022-5-22 17:56
这种简单的你自己凑凑应该是可以拼起来的吧
哈哈，你都从小白到大神了，我悟性比较低，大神，你帮忙看看，能不能让白线不超出两点
xj6019 发表于 2022-5-22 17:45
(defun C:NM (/ p1 p1d p2 ps ps1 ps2 ang)
(setq p1 (getpoint "\n第一点:") ...
厉害厉害了 xyp1964 发表于 2022-5-22 20:26
院长大人给的动图，效果实现的真棒，谢谢院长大人的参与
本帖最后由 jjj666 于 2022-5-22 22:30 编辑
我也来凑个热闹：
(defun c:asas( / p1 p2 L d da x1 y1 x2 y2 x y xp1 xp2 pl1 pl2 p11);生成直线阵列
(setvar "cmdecho" 0)
(princ "\n本程序用于在给定的两点之间生成直线阵列。")
(setq p1 (getpoint "\n指定第一点:"))
(setq p2 (getpoint "\n指定第二点:"))
(setq L (getreal "\n请输入直线的长度(Enter 默认100)："))
(if (= L nil ) (setq L 100))
(setq d (getreal "\n请输入直线的间距(Enter 默认20)："))
.......
(princ)
)
这个不超出。d:\as.jpg
页:
[1]
2