明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
12
返回列表 发新帖
楼主: 树櫴希德

随机高程--明经论坛各位大神函数,感谢

[复制链接]
发表于 2020-4-9 18:16:23 | 显示全部楼层
怎么联系下啊
发表于 2020-4-23 21:19:57 | 显示全部楼层

应该是为了图面更好看
 楼主| 发表于 2020-11-17 21:02:00 | 显示全部楼层
  1. ;;框选范围内交点插入图块  By Gu_xl 2011.04

  2. ;;;计算曲线交点

  3. (defun Curveinters (en1 en2 / pl pts)

  4.   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))

  5.   (while pl

  6.     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))

  7.    pl (cdr (cdr (cdr pl)))

  8.    )

  9.     )

  10. pts

  11.   )

  12. ;;;曲线选择集交点

  13. (defun ssinters (ss / pts en1 en2)

  14.   (while (> (sslength ss) 1)

  15.     (setq en1 (ssname ss 0))

  16.     (ssdel en1 ss)

  17.     (setq n (sslength ss))

  18.     (repeat n

  19.       (setq en2 (ssname ss (setq n (1- n))))

  20.       (setq pts (append pts (Curveinters en1 en2)))

  21.       )

  22.     )

  23.   pts

  24.   )





  25. ;;;实例: 按选择范围框内插入图块

  26. (defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho blockname )

  27.   (setq os (getvar "osmode"))

  28.   (setq cmdecho (getvar "cmdecho"))

  29.   (setvar "osmode" 0)

  30.   (setvar "cmdecho" 0)

  31.   (setq blockname (getstring  "\n插入块名称:"))

  32.   (if (null d) (setq d 1.))

  33.   (while (and

  34.            (setq p1 (getpoint "\n选择插入范围左下角:"))

  35.            (setq p2 (GETCORNER p1 "\n选择插入范围左下角:"))

  36.            )

  37.     (setq minX (apply 'min (mapcar 'car (list p1 p2)))

  38.           minY (apply 'min (mapcar 'cadr (list p1 p2)))

  39.           maxX (apply 'max (mapcar 'car (list p1 p2)))

  40.           maxY (apply 'max (mapcar 'cadr (list p1 p2)))

  41.           )

  42.     (grvecs (list 1 (list minx miny) (list maxx miny)

  43.                   1 (list maxx miny) (list maxx maxy)

  44.                   1 (list maxx maxy) (list minx maxy)

  45.                   1 (list minx maxy) (list minx miny)

  46.                   )

  47.             )

  48.     (setq ss (ssget "c" p1 p2 '((0 . "*line"))))

  49.     (if ss

  50.       (progn

  51.         (setq pts (ssinters ss))

  52.         (if pts

  53.           (foreach pt pts

  54.             (if (and (>= maxX (car pt) minX)

  55.                      (>= maxY (cadr pt) minY)

  56.                      )

  57.               ;;插入图块

  58.               (command "insert" blockname "_non" pt 1 1 0)

  59.               )

  60.             )

  61.           )

  62.         )

  63.       )

  64.     (princ "\n ***回车键结束***")

  65.     )

  66. (setvar "osmode" os)

  67.   (setvar "cmdecho" cmdecho)

  68.   (princ)

  69.   )

发表于 2020-11-29 21:20:34 | 显示全部楼层

仅为lisp学习!
发表于 2024-12-6 08:14:03 | 显示全部楼层
很不错 学习了
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-12-23 11:58 , Processed in 0.153614 second(s), 18 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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