设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 分享一个可以画斜线15°外廓线的代码
12下一页
返回列表 发新帖
查看: 281|回复: 21

[源码] 分享一个可以画斜线15°外廓线的代码

[复制链接]
Qwer1243
发表于 昨天 09:19 | 显示全部楼层 |阅读模式
本帖最后由 Qwer1243 于 2024-9-24 11:41 编辑

在放样水撑和柱撑详图的过程中可能会用到，有需要的可以看一下；有优化意见的欢迎分享
  2. (defun c:e7 (/ ang c data line m m_perp pt pt1 pt2 pt3 pt4 x x1 x2 y y_proj y1 y2)
  3.   (setvar "cmdecho" 0)
  4.   (setq line (entsel "\n选择直线: "))
  5.   (setq pt (getpoint "\n请指定方向: "))
  6.   (setq data (entget (car line)))
  7.   (setq x1 (cadr (assoc 10 data)) x2 (cadr (assoc 11 data)) y1 (caddr (assoc 10 data)) y2 (caddr (assoc 11 data)))
  8.   
  9.   ;;选择直线为水平线
  10.   (if (= y1 y2)
  11.     (progn
  12.       (princ "\n为水平线")
  13.       (setq ang (/ pi 2))
  14.       (if (< x1 x2)
  15.         (progn
  16.           (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
  17.           (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
  18.         )
  19.         (progn
  20.           (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
  21.           (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
  22.         )
  23.       )
  24.       (if (> (cadr pt) y1)
  25.         (progn
  26.           (princ "\n点在直线上方。")
  27.           (setq pt3 (polar pt1 (+ ang (* pi (/ 15 180.0))) 300))
  28.           (setq pt4 (polar pt2 (- ang (* pi (/ 15 180.0))) 300))
  29.         )
  30.         (progn
  31.           (princ "\n点在直线下方。")
  32.           (setq pt3 (polar pt1 (- ang (* pi (/ 195 180.0))) 300))
  33.           (setq pt4 (polar pt2 (+ ang (* pi (/ 195 180.0))) 300))
  34.         )
  35.       )
  36.     )
  37.   )
  38.   
  39.   ;;选择直线为竖直线
  40.   (if (= x1 x2)
  41.     (progn
  42.       (princ "\n为竖直线")
  43.       (setq ang 0)
  44.       (if (< y1 y2)
  45.         (progn
  46.           (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
  47.           (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
  48.         )
  49.         (progn
  50.           (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
  51.           (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
  52.         )
  53.       )
  54.       (if (> (car pt) x1)
  55.         (progn
  56.           (princ "\n点在直线右侧。")
  57.           (setq pt3 (polar pt1 (- ang (* pi (/ 15 180.0))) 300))
  58.           (setq pt4 (polar pt2 (+ ang (* pi (/ 15 180.0))) 300))
  59.         )
  60.         (progn
  61.           (princ "\n点在直线左侧。")
  62.           (setq pt3 (polar pt1 (+ ang (* pi (/ 195 180.0))) 300))
  63.           (setq pt4 (polar pt2 (- ang (* pi (/ 195 180.0))) 300))
  64.         )
  65.       )
  66.     )
  67.   )
  68.   
  69.   ;;选择直线为斜线
  70.   (if (and (/= x1 x2) (/= y1 y2))
  71.     (progn
  72.       (princ "\n为斜线")
  73.       (if (< y1 y2)
  74.         (progn
  75.           (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
  76.           (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
  77.         )
  78.         (progn
  79.           (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
  80.           (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
  81.         )
  82.       )
  83.       
  84.       ; 计算斜率 m 和截距 c
  85.       (setq m (/ (- (cadr pt2) (cadr pt1)) (- (car pt2) (car pt1))))
  86.       (setq c (- (cadr pt1) (* m (car pt1))))
  87.       
  88.       ; 计算垂直线的斜率
  89.       (setq m_perp (- (/ 1 m)))
  90.       
  91.       ; 计算角度
  92.       (setq ang (atan m_perp))
  93.       
  94.       ;计算点 P 到直线的垂直投影点的 y 坐标
  95.       (setq x (car pt))
  96.       (setq y_proj (+ (* m x) c))
  97.       
  98.       ;判断点的位置
  99.       (if (> ang 0)
  100.         (if (> (cadr pt) y_proj)
  101.           (progn
  102.             (princ "\n点在直线上方。")
  103.             (setq pt3 (polar pt1 (- ang (* pi (/ 15 180.0))) 300))
  104.             (setq pt4 (polar pt2 (+ ang (* pi (/ 15 180.0))) 300))
  105.           )
  106.           (progn
  107.             (princ "\n点在直线下方。")
  108.             (setq pt3 (polar pt1 (+ ang (* pi (/ 195 180.0))) 300))
  109.             (setq pt4 (polar pt2 (- ang (* pi (/ 195 180.0))) 300))
  110.           )
  111.         )
  112.         (if (> (cadr pt) y_proj)
  113.           (progn
  114.             (princ "\n点在直线上方。")
  115.             (setq pt3 (polar pt1 (+ ang (* pi (/ 195 180.0))) 300))
  116.             (setq pt4 (polar pt2 (- ang (* pi (/ 195 180.0))) 300))
  117.           )
  118.           (progn
  119.             (princ "\n点在直线下方。")
  120.             (setq pt3 (polar pt1 (- ang (* pi (/ 15 180.0))) 300))
  121.             (setq pt4 (polar pt2 (+ ang (* pi (/ 15 180.0))) 300))
  122.           )
  123.         )
  124.       )
  125.     )
  126.   )
  127.   
  128.   (entmakeX (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))
  129.   (entmakeX (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))
  130.   (princ)
  131. )

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

点评

xyp1964
选水平线报错  发表于 昨天 09:46

评分

参与人数 2明经币 +2 收起 理由
cghdy + 1 赞一个!
bssurvey + 1 赞一个!

查看全部评分

回复

使用道具 举报

自贡黄明儒
发表于 昨天 11:54 | 显示全部楼层
本帖最后由 自贡黄明儒 于 2024-9-24 14:57 编辑
Qwer1243 发表于 2024-9-24 11:45
我不会做面板，你要是方便的话可以帮忙更新一下面板，我刚才重新上传了代码，水平和竖直线不会报错了

  1. (defun C:Ban (/ dialog getdata setdata do1 DCLID FN FNAME)
  2.   (defun dialog        ()
  3.     (setq fname (vl-filename-mktemp nil nil ".dcl"))
  4.     (setq fn (open fname "w"))
  5.     (write-line        "HHbianban : dialog{label=\"画边板 黄明儒\";"
  6.                 fn
  7.     )
  8.     (write-line        " :edit_box{label=\"边距 (mm)\";key=\"key1\";value=\"20\";}"
  9.                 fn
  10.     )
  11.     (write-line        " :edit_box{label=\"角度(mm)\";key=\"key2\";value=\"15\";}"
  12.                 fn
  13.     )
  14.     (write-line        " :edit_box{label=\"离端部 倍数\";key=\"key3\";value=\"1.5\";}"
  15.                 fn
  16.     )
  17.     (write-line " ok_cancel;" fn)
  18.     (write-line "  }" fn)
  19.     (close fn)
  20.   )

  22.   (defun getdata (/ DCLDATA I KEY)
  23.     (setq i 0)
  24.     (repeat 3                                                    ;"key1"到"key5"
  25.       (setq i (1+ i))
  26.       (setq key (strcat "key" (itoa i)))
  27.       (set (read key) (get_tile key))
  28.       (setq DCLData (cons (cons key (eval (read key))) DCLData))
  29.     )
  30.     (Setenv "HHbianban" (VL-PRIN1-TO-STRING DCLData))
  31.   )

  33.   (defun setdata (/ DCLDATA X)
  34.     (cond ((setq DCLData (getenv "HHbianban"))
  35.            (setq DCLData (read DCLData))
  36.            (mapcar '(lambda (x) (Set_tile (car x) (cdr x))) DCLData)
  37.           )
  38.     )
  39.   )

  41.    (defun do1 ()
  42.     (ACET-UNDO-BEGIN)                                            ;编组
  43.     (setq e0 (entlast))
  44.     (if        (setq e (entsel "\n 型钢端线:"))
  45.       (progn
  46.         (setq p0 (cadr e))
  47.         (setq obj (vlax-ename->vla-object (car e)))
  48.         (setq key3 (* (distof key3) (vlax-get obj 'length)))
  49.         (setq key3 (VL-PRINC-TO-STRING key3))
  50.         (vl-cmdf "_offset" key3 e pause "")
  51.       )
  52.     )
  53.     ;;如果偏移成功
  54.     (setq e (entlast))
  55.     (if        (not (equal e e0))
  56.       (do2 e)
  57.     )
  58.     (ACET-UNDO-END)
  59.   )


  62.   ;;与PPCAD保持一致
  63.   (if (not (tblsearch "layer" "4虚线层"))
  64.     (vl-cmdf "_layer" "_M" "4虚线层" "_C" 6 "" "L" "DASHED" "" "")
  65.   )

  67.   (dialog)
  68.   (setq dclid (load_dialog fname))
  69.   (new_dialog "HHbianban" dclid)
  70.   (setdata)
  71.   (action_tile "accept" "(getdata)(done_dialog 1)")
  72.   (action_tile "cancel" "(getdata)(done_dialog 0)")
  73.   (setq return# (start_dialog))
  74.   (unload_dialog dclid)
  75.   (vl-file-delete fname)
  76.   (cond ((equal return# 1) (do1)))
  77. )

do2就交给你了
回复 支持 反对

使用道具 举报

Qwer1243
 楼主| 发表于 昨天 10:27 | 显示全部楼层
自贡黄明儒 发表于 2024-9-24 10:14
机械行业同行呀，这个不错。以往我都是手画的。
选择角钢端部那条线，每边留20mm，以便于焊接，再沿角钢另 ...

我是钢结构深化的，经常会用到，两边的却是经常预留20mm，是不是规范我也不清楚
回复 支持 反对

使用道具 举报

Qwer1243
 楼主| 发表于 昨天 12:08 | 显示全部楼层
自贡黄明儒 发表于 2024-9-24 11:54
do1就交给你了

我看一下，试着调整一下
离端部倍数，说的是我下面图片箭头指示这个吗？C:\Users\Administrator\Desktop\1727150774230.jpg

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

点评

自贡黄明儒
是  发表于 昨天 12:27
回复 支持 反对

使用道具 举报

自贡黄明儒
发表于 昨天 10:14 | 显示全部楼层
机械行业同行呀，这个不错。以往我都是手画的。
选择角钢端部那条线，每边留20mm，以便于焊接，再沿角钢另一边移动一个距离（不知道这个距离有没有规范要求），这样更智能。
回复 支持 反对

使用道具 举报

tiancao100
发表于 昨天 10:19 | 显示全部楼层
这不钢结构嘛， 必须15度吗? 不能自动剪裁
回复 支持 反对

使用道具 举报

自贡黄明儒
发表于 昨天 10:25 | 显示全部楼层
tiancao100 发表于 2024-9-24 10:19
这不钢结构嘛， 必须15度吗? 不能自动剪裁

这个角度应该是个变值，可以取0度。关键楼主点取那条线，到角钢端部，有没有规范要求。
回复 支持 反对

使用道具 举报

Qwer1243
 楼主| 发表于 昨天 10:28 | 显示全部楼层
tiancao100 发表于 2024-9-24 10:19
这不钢结构嘛， 必须15度吗? 不能自动剪裁

15度，可以在代码里面调整，一般都是15度，我就没添加调整参数
回复 支持 反对

使用道具 举报

自贡黄明儒
发表于 昨天 11:23 | 显示全部楼层
本帖最后由 自贡黄明儒 于 2024-9-24 14:54 编辑
Qwer1243 发表于 2024-9-24 10:28
15度，可以在代码里面调整，一般都是15度，我就没添加调整参数

弄个界面，适应各种情况

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

Qwer1243
 楼主| 发表于 昨天 11:42 | 显示全部楼层
我更新了一下代码，可以使用与水平和竖直线了@xyp1964
回复 支持 反对

使用道具 举报

Qwer1243
 楼主| 发表于 昨天 11:45 | 显示全部楼层
自贡黄明儒 发表于 2024-9-24 11:23
弄个界面，适应各种情况

我不会做面板，你要是方便的话可以帮忙更新一下面板，我刚才重新上传了代码，水平和竖直线不会报错了
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-9-25 04:39 , Processed in 0.160286 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表