求一个从直线中点向两边画直线的程序

叁點壹肆

小弟求一个从直线中点向两边画直线的程序，点击确定位置（位置为直线中点）然后手动确认方向直线的旋转方向中，有没有大佬能帮忙写一个，感激不尽

nzdog

是这样的插件吗？

qifeifei

要给出 图片演示呢

vitalgg

如果无法播放，请点击此处在新窗口打开

运行以下代码需先从网络加载@lisp函数库(代码中的第一行)也就是 需要CAD可以访问网络。
如果防火墙限制了 CAD 联网，可以本地安装 @lisp核心管理器。

1. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get-property o'ResponseText))))
   
2. (defun seg-mid ()
   
3.   "从直线中点向两边画直线的程序，点击确定位置（位置为直线中点）然后手动确认方向直线的旋转方向"
   
4.   (setq lines (pickset:to-list (ssget '((0 . "line")))))
   
5.   (setq segs
   
6.   (mapcar  '(lambda(x)
   
7.         (setq  pt-mid(curve:midpoint x))
   
8.         (entity:make-line
   
9.          (polar pt-mid 0 100)
   
10.          (polar pt-mid pi 100)))
    
11.      lines))
    
12.   
    
13.          
    
14.   (mapcar '(lambda(x)
    
15.        (ui:dynrotate x
    
16.          (curve:midpoint x)))
    
17.     segs))
    

(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get-property o'ResponseText))))<br /> (defun seg-mid ()<br />   "从直线中点向两边画直线的程序，点击确定位置（位置为直线中点）然后手动确认方向直线的旋转方向"<br />   (setq lines (pickset:to-list (ssget '((0 . "line")))))<br />   (setq segs <br />   (mapcar  '(lambda(x)<br />         (setq  pt-mid(curve:midpoint x))<br />         (entity:make-line<br />          (polar pt-mid 0 100)<br />          (polar pt-mid pi 100)))<br />      lines))<br />   <br />          <br />   (mapcar '(lambda(x)<br />        (ui:dynrotate x<br />          (curve:midpoint x)))<br />     segs))<br />

明_明

“XLINE” 命令就可以吧

xyp1964

;; 非源码

叁點壹肆

nzdog 发表于 2026-1-10 17:09
是这样的插件吗？

非常感谢