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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 大神们进来支支招啊
12下一页
返回列表 发新帖
查看: 1094|回复: 11

[提问] 大神们进来支支招啊

[复制链接]
被承包的东子
发表于 2016-3-31 11:23 | 显示全部楼层 |阅读模式
本帖最后由 被承包的东子 于 2016-4-3 22:17 编辑

我想要改进的就是，
1，框选一次，就能把程序运行完成
2，（已用” fan_zh“大神的方法改进过，非常感谢）这段代码中的“repeat”部分，应该是太啰嗦了，想简化，也是不知道有什么合适的函数代替（从一组表中，选出所有群码为10的参数——四个点的坐标，我用的是重复比对筛选，很笨的方法）
  2. (defun c:t1()
  3.    (nl)
  4. (prompt "\n----------------框选线条---------------")
  5.    (setq ss1 (ssget))
  6.    (tst1)
  7.    (prompt "\n----------框选欲更新的洞口----------")
  8.    (setq ss (ssget))
  9.    (setq nq 0 k 0)
  10.    (setq mq (sslength ss))
  11.   (repeat mq
  12.   (Setq en (ssname ss nq))
  13.   (setq hole1_data(entget en))
  14.   (ts1)
  15.     (princ)
  16.     (command "pline" hd ha hb he hd hc hb "")
  17.    
  18.   (setq nq (+ 1 nq))
  19.   (setq k (+ 1 k))
  20.   )
  21. (command "erase" ss "")
  22.    (setvar "osmode" old)
  23.    ()
  24.    (print "程序运行结束，谢谢使用!")
  25.    )


  28. ;========================================计算"7"个关键点坐标========================================
  29. (defun TS1()
  30.   (setq old (getvar "osmode"))
  31.    (setvar "osmode" 0)
  32.       (setq pts nil)
  33.       (foreach pt hole1_data (if (= (car pt) 10) (setq pts (cons (cdr pt) pts))))
  34.       (setq ha (car pts))
  35.       (setq hb (cadr pts))
  36.       (setq hc (caddr pts))
  37.       (setq hd (cddr (cdr pts)))
  38.   


  41.   
  42. ;(落后的筛选方式!!!)
  43.   ;(setq l1 (length hole1_data))
  44.   ;(repeat l1 (if (= 10 (car (car hole1_data))) (setq ha (cdr (car hole1_data))) (setq hole1_data (cdr hole1_data))))
  45.   ;(setq hole2_data (cdr hole1_data))
  46.   ;(repeat l1 (if (= 10 (car (car hole2_data))) (setq hb (cdr (car hole2_data))) (setq hole2_data (cdr hole2_data))))
  47.   ;(setq hole3_data (cdr hole2_data))
  48.   ;(repeat l1 (if (= 10 (car (car hole3_data))) (setq hc (cdr (car hole3_data))) (setq hole3_data (cdr hole3_data))))
  49.   ;(setq hole4_data (cdr hole3_data))
  50.   ;(repeat l1 (if (= 10 (car (car hole4_data))) (setq hd (cdr (car hole4_data))) (setq hole4_data (cdr hole4_data))))
  51.   ;求四角点坐标z
  52.   ;(setq ha (cdr (nth 16 hole1_data)))
  53.   ;(setq hb (cdr (nth 21 hole1_data)))
  54.   ;(setq hc (cdr (nth 26 hole1_data)))
  55.   ;(setq hd (cdr (nth 31 hole1_data)))
  56.   ;算折点坐标
  57. ;(此段作废!!!)

  59.   (setq x1 (car ha))
  60.   (setq y1 (cadr ha))
  61.   (setq x2 (car hc))
  62.   (setq y2 (cadr hc))
  63.   (setq ah (min x1 x2))
  64.   (setq bh (max x1 x2))
  65.   (setq hh (min y1 y2))
  66.   (setq dh (max y1 y2))
  67.   (setq fh (* 0.3 (min (- bh ah) (- dh hh))))
  68.   (setq m (+ ah  fh))
  69.   (setq n (- dh fh))
  70.   (setq he (list m n))
  71.   (setq ha (list ah dh))
  72.   (setq hb (list bh dh))
  73.   (setq hc (list bh hh))
  74.   (setq hd (list ah hh))

  76.    (setvar "osmode" old)
  77. )

  79. ;=======================================设置“线段”变“多段线”======================================
  80. (defun tst1 ()
  81.   (command "_pedit" "m" ss1 "" "" "j" "" "")
  82.   (print "线段连成多段线设置成功!!!")
  83.   
  84. )

  86. ;========================================设置洞口“hole”图层========================================
  87. (defun nl ()  
  88. (setq chklay (tblsearch "layer" "HOLE"))
  89.   (if (= chklay nil)
  90.    (command "layer" "n" "hole" "c" "5" "hole" "m" "hole" "")
  91.     (command "layer" "m" "hole" "")
  92.   )
  93.   (print "图层设置成功!!!")
  94.   )
洞口

本帖子中包含更多资源

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

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下

相关帖子
回复

使用道具 举报

dadiwusheng
发表于 2016-3-31 11:49 | 显示全部楼层
暖通的吗，我也是做暖通的
回复 支持 反对

使用道具 举报

fan_zh
发表于 2016-3-31 13:30 | 显示全部楼层
     (setq el (entget (car (entsel))))
      (setq pts nil)
      (foreach pt el (if (= (car pt) 10) (setq pts (cons (cdr pt) pts))))
回复 支持 反对

使用道具 举报

被承包的东子
 楼主| 发表于 2016-4-1 08:23 | 显示全部楼层
dadiwusheng 发表于 2016-3-31 11:49
暖通的吗，我也是做暖通的

我是做结构的，这是帮建筑设计的程序
回复 支持 反对

使用道具 举报

被承包的东子
 楼主| 发表于 2016-4-1 08:24 | 显示全部楼层
fan_zh 发表于 2016-3-31 13:30
(setq el (entget (car (entsel))))
      (setq pts nil)
      (foreach pt el (if (= (car pt) 1 ...

谢谢 ，我拿去调试调试
回复 支持 反对

使用道具 举报

love1030312
发表于 2016-4-2 14:46 | 显示全部楼层
第一步直接到目的多好呀 中间那步是必须要的 还是 只是个过程
回复 支持 反对

使用道具 举报

被承包的东子
 楼主| 发表于 2016-4-2 15:36 | 显示全部楼层
本帖最后由 被承包的东子 于 2016-4-2 15:41 编辑
love1030312 发表于 2016-4-2 14:46
第一步直接到目的多好呀 中间那步是必须要的 还是 只是个过程
中间 那一步是为了让程序识别洞口的四个角点并获取其坐标，我不会其他的直接从散乱的线段中识别洞口角点坐标。

回复 支持 反对

使用道具 举报

被承包的东子
 楼主| 发表于 2016-4-2 15:39 | 显示全部楼层
被承包的东子 发表于 2016-4-2 15:36
什么意思啊

中间那步主要是为了把零散的线段连接在一起，这样再框选的时候，就能简单的识别出各个洞口的角点坐标。
因为我对lisp不熟悉，”对于散乱的多个线段，识别出是各个洞口的点坐标“，没有其他方法，只有通过这样转换的方式。。
回复 支持 反对

使用道具 举报

被承包的东子
 楼主| 发表于 2016-4-3 22:12 | 显示全部楼层
求大神们支支招啊，第二个循环部分的改进 我调试好了，第一个改进的地方，我还是想不到办法
回复 支持 反对

使用道具 举报

tryhi
发表于 2016-4-4 22:15 | 显示全部楼层
本帖最后由 tryhi 于 2016-4-5 22:20 编辑
  2. (defun c:tt (/ enla enlist lst old pllst ss ss2)
  3. (vl-Load-COM)
  4.         (setq ss(ssget '((0 . "LINE")))enla(entlast))
  5.   (command "_pedit" "m" ss "" "" "j" "" "")
  6.         (setq ss2(try-ssend enla)
  7.                 enlist(ss2EnList ss2)
  8.                 lst(mapcar 'getbox enlist)
  9.                 pllst (mapcar '_pt7 lst)
  10.                 old (getvar "osmode")
  11.         )
  12.         (setvar "osmode" 0)
  13.         (foreach n pllst (apply 'command (cons "pline" n)))
  14.         (setvar "osmode" old)
  15. )
  16. (defun _pt7 (ptlst / p2 p4 p6 pt4 x)
  17.         (setq pt4(try-pt2-to-pt4 (car ptlst)(cadr ptlst))
  18.                 x(* 0.25 (distance (setq p2(cadr pt4))(setq p4(cadddr pt4))))
  19.                 p6 (polar p2 (angle (cadr pt4)p4) x))
  20.         (append pt4 (list (car ptlst) p6 (cadr ptlst) ""))
  21. )
  22. (defun ss2EnList(ss / a en lst)
  23.         (setq a -1)
  24.         (while
  25.                 (setq en(ssname ss(setq a(1+ a))))
  26.                 (setq lst(cons en lst))
  27.         )
  28. )
  29. (defun getbox(e)
  30.         (vla-GetBoundingBox (vlax-ename->vla-object e) 'p1 'p2);取得包容图元的最大点和最小点
  31.         (list (vlax-safearray->list p1) (vlax-safearray->list p2))
  32. )
  33. (defun try-pt2-to-pt4 (pt1 pt2)
  34.         (list pt1 (list(car pt1)(cadr pt2))pt2(list (car pt2)(cadr pt1)))
  35. )
  36. (defun try-ssend(en / ss)
  37.         (setq ss (ssadd))
  38.         (while (setq en(entnext en))
  39.                 (setq ss(ssadd en ss))
  40.         )
  41.         ss
  42. )
完全按照楼主思路写的代码，另外提示一句，楼主开洞的位置是左上角的点往右下角偏0.3宽度，这样的不对的，当宽很大高很窄的时候就会出错，所以这里改了一下，改为开洞位置为左上至右下对角线的四分之一处
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-19 11:45 , Processed in 0.270318 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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