明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
12
返回列表 发新帖
楼主: yjwht

[源码] 电缆水平偏移弯曲线绘制

  [复制链接]
 楼主| 发表于 前天 09:39 | 显示全部楼层
是根据本论坛中代码修改的,但找不到原有贴子了,所有放在这供大家参考。

1、简化了绘制内容,不设箭头、不设中间拐点,因为我用不到;
2、增加了比例值的设置,还是因为需求;
3、增加了根据垂足的绘制方式。
  1. ;箭头和文字的设置请自行更改程序
  2. (defun c:tt();剖面符号绘制程序
  3.   (setq k (getreal "\n输入图纸比例<1.0>:"))
  4.   (if (null k) (setq k 1.0))
  5.   (setq w (* k 0.5));线宽为0.5的倍数
  6.   
  7.   (setq txt (strcase(getstring "输入剖面符号字母<A>:")))
  8.   (if (< (strlen txt) 1) (setq txt "A"))

  9.   (setq p0 (getpoint "\n指定第一点:"))
  10.   (setq p1 (getpoint p0 "\n指定下一点或[非水平、垂直时剖面轴上的垂足]:"))
  11.   (if (and (not (= (cadr p0) (cadr p1)))
  12.      (not (= (car p0) (car p1))))
  13.     (setq p1 (polar p1 (angle p0 p1) (distance p0 p1))))

  14.   (pmfh_draw)
  15.   (pmfh_jtfx)
  16.   (pmfh_jt)
  17.   (prin1)
  18.   )

  19. (defun pmfh_draw ();预绘制图形
  20.   (redraw)
  21.   (grdraw p0 (polar p0 (angle p0 p1) (* 5 k)) 1)
  22.   (grdraw p1 (polar p1 (angle p1 p0) (* 5 k)) 1)
  23.   )

  24. (defun pmfh_jtfx ();判断箭头方向
  25.   (setq go 1)
  26.   (while go
  27.     (setq grd (grread 1 15 0) gr (car grd) grr (cadr grd))
  28.     (setq anga (angle p1 p0)
  29.     angb (angle p1 grr)
  30.     angc (- anga angb)
  31.     angx (angle p0 p1))
  32.     (cond ((= gr 5)
  33.      (if (or (> angc pi) (and (> angc (- pi)) (< angc 0)))
  34.        (progn
  35.          (redraw)
  36.          (setq py (polar p1 (+ anga (angtof "90")) 5))
  37.          (grdraw p1 py 3)
  38.          (grdraw py (polar py (- (angle py p1) (angtof "30")) 2) 3)
  39.          (grdraw py (polar py (+ (angle py p1) (angtof "30")) 2) 3)
  40.          (setq ang1 (- (angle p0 p1) (angtof "90"))
  41.          ang2 (- angx (angtof "90")))
  42.          )
  43.        (progn
  44.          (redraw)
  45.          (setq py (polar p1 (- anga (angtof "90")) 5))
  46.          (grdraw p1 py 3)
  47.          (grdraw py (polar py (- (angle py p1) (angtof "30")) 2) 3)
  48.          (grdraw py (polar py (+ (angle py p1) (angtof "30")) 2) 3)
  49.          (setq ang1 (+ (angle p0 p1) (angtof "90"))
  50.          ang2 (+ angx (angtof "90")))
  51.          )
  52.        )
  53.      )
  54.     ((= gr 3)(setq go nil))
  55.     )
  56.     )
  57.   )

  58. (defun pmfh_jt();绘制箭头
  59.   (redraw)
  60.   (setq a (* 3.5 k);a 的值设置箭头和文字大小
  61.   pl1 (polar p0 ang1 (* a 2))
  62.   pl2 (polar p1 ang2 (* a 2)))
  63.   (command ".undo" "be");开始记录一个新的撤销单元
  64.   (entmake (list '(0 . "LWPOLYLINE");绘制第一个箭头
  65.      '(100 . "AcDbEntity")
  66.      '(100 . "AcDbPolyline")
  67.      (cons 90 3)
  68.      (cons 10 pl1)
  69.      (cons 40 w)
  70.      (cons 41 w)
  71.      (cons 10 p0)
  72.      (cons 40 w)
  73.      (cons 41 w)
  74.      (cons 10 (polar p0 (angle p0 p1) a))
  75.      (cons 40 w)
  76.      (cons 41 w)))
  77.   (entmake (list '(0 . "TEXT");第一个箭头文字
  78.      '(62 . 3)
  79.      (cons 10 (polar p1 (+ ang2 (angtof "35")) (* a 1.5)))
  80.      (cons 40 a)
  81.      (cons 1 txt)
  82.      '(72 . 1)
  83.      '(73 . 2)
  84.      (cons 11 (polar p0 (- ang1 (angtof "35")) (* a 1.5)))))
  85.   (entmake (list '(0 . "LWPOLYLINE");绘制第二个箭头
  86.      '(100 . "AcDbEntity")
  87.      '(100 . "AcDbPolyline")
  88.      (cons 90 3)
  89.      (cons 10 pl2)
  90.      (cons 40 w)
  91.      (cons 41 w)
  92.      (cons 10 p1)
  93.      (cons 40 w)
  94.      (cons 41 w)
  95.      (cons 10 (polar p1 (angle p1 p0) a))
  96.      (cons 40 w)
  97.      (cons 41 w)))
  98.   (entmake (list '(0 . "TEXT");第二个箭头文字
  99.      '(62 . 3)
  100.      (cons 10 (polar p1 (+ ang2 (angtof "35")) (* a 1.5)))
  101.      (cons 40 a)
  102.      (cons 1 txt)
  103.      '(72 . 1)
  104.      '(73 . 2)
  105.      (cons 11 (polar p1 (+ ang2 (angtof "35")) (* a 1.5)))))
  106.   (setq n 0)
  107.   (command ".undo" "e");结束当前撤销单元的记录
  108.   )

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-7-24 15:36 , Processed in 0.167180 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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