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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 板筋镜像-点选版（源码共享给大家）
12下一页
返回列表 发新帖
查看: 2420|回复: 12

[源码] 板筋镜像-点选版（源码共享给大家）

[复制链接]
叶曲冰寒
发表于 2015-2-6 11:28 | 显示全部楼层 |阅读模式
本帖最后由 叶曲冰寒 于 2015-2-6 12:54 编辑


  1. ;;;文字前处理[程序]
  2. ;;;处理文字转角90°在0.001°误差内全部处理成90°
  3. (defun C:BJQCL(/ sstxt txti)
  4.   (setq ssTxt (ssget "all" '((0 . "TEXT"))))
  5.   (if ssTxt
  6.     (progn
  7.       (setq txti 0)
  8.       (repeat (sslength ssTxt)
  9.         (if (< (abs (- 90 (* (vla-get-Rotation (vlax-ename->vla-object (ssname ssTxt txti))) (/ 180 pi)))) 0.001)
  10.           (vla-put-Rotation (vlax-ename->vla-object (ssname ssTxt txti)) (* 90 (/ pi 180)))
  11.         )
  12.         (setq txti (1+ txti))
  13.       )
  14.       (print (read "=======文字已经过修正处理。。。"))
  15.       (print)
  16.       (princ)
  17.     )
  18.   )
  19. )

  21. (C:BJQCL)
  22. (setvar "MIRRTEXT" 0)





  28. ;;;板筋镜像-点选版(新版)[程序]
  29. (prompt "=======欢迎使用板筋镜像程序，此版本为点选版本，后续会发布框选版本，尽请期待!!")
  30. (print)
  31. (prompt "=======执行板筋镜像前建议先进行板筋前处理(BJQCL)避免竖向钢筋文字90度转角不精确情况=======")
  32. (print)
  33. (prompt "=======作者:Helchan======QQ群:425314779=======")
  34. (print)
  35. (print "******版本号2.1******")
  36. (print)
  37. (defun c:BJJX(/ 02i 04i 06st 07i 07j 08ang1 08ang2 08dd 09cp_lst 09i 09ss 09sscp 10i ddang ename inters_pt layernewfs layernewtxt lst_basefslayer lst_basefslayertxt lst_fspt new_text_insert_pt num_pt pt1 pt2 pt3 pt4 pta ptb ptta pttb ss_01fs ss_03fstxt text_insert_pt text_inserts_pt_dd 文字转角)

  39.   ;;01.获取基准板筋图层while循环【ss_01Fs】
  40.   (while (not (setq ss_01Fs (cadr (list (print (read "请点选板筋用于图层识别:")) (ssget))))))
  41.   ;;02.将获取到的板筋取出图层名组成板筋图层名基准表【lst_BaseFsLayer】
  42.   (setq lst_BaseFsLayer nil)
  43.   (setq 02i 0)
  44.   (repeat (sslength ss_01Fs)
  45.     (if (not (member (setq layerNewFs (cdr (assoc 8 (entget (ssname ss_01Fs 02i))))) lst_BaseFsLayer))
  46.       (setq lst_BaseFsLayer (cons layerNewFs lst_BaseFsLayer))
  47.     )
  48.     (setq 02i (1+ 02i))
  49.   );;end repeat
  50.   
  51.   
  52.   ;;03.获取基准板筋文字图层while循环【ss_03FsTxt】
  53.   (while (not (setq ss_03FsTxt (cadr (list (print (read "请点选板筋文字用于图层识别:")) (ssget)))))(print))
  54.   ;;04.将获取到的板筋文字取出图层名组成板筋文字图层名基准表【lst_BaseFsLayerTxt】
  55.   (setq lst_BaseFsLayerTxt nil)
  56.   (setq 04i 0)
  57.   (repeat (sslength ss_03FsTxt)
  58.     (if (not (member (setq layerNewTxt (cdr (assoc 8 (entget (ssname ss_03FsTxt 04i))))) lst_BaseFsLayerTxt))
  59.       (setq lst_BaseFsLayerTxt (cons layerNewTxt lst_BaseFsLayerTxt))
  60.     )
  61.     (setq 04i (1+ 04i))
  62.   );;end repeat
  63.   
  64.   
  65.   ;;05.根据点选的板筋对板筋进行处理while大循环
  66.   (while T
  67.     ;;06.点选钢筋循环，如果是pl且根据图层分析在板筋图层则跳出此while循环
  68.     (setq 06st T)
  69.     (while 06st
  70.       (setq ename (car (entsel "请点选板钢筋:")))
  71.       ;;如果获取到了图元【ename】
  72.       (if ename
  73.         ;;如果获取的图元是多段线，且图层是板筋图层
  74.         (if (and (member (cdr (assoc 8 (entget ename))) lst_BaseFsLayer) (= "LWPOLYLINE" (cdr (assoc 0 (entget ename)))))
  75.           (progn
  76.             ;;存储板筋多段线顶点的表【lst_FsPt】
  77.             (setq lst_FsPt nil)
  78.             ;;start foreach 将顶点存储到顶点表中
  79.             (foreach tempt (entget ename)
  80.               (if (= (car tempt) 10)
  81.                 (setq lst_FsPt (cons (cdr tempt) lst_FsPt))
  82.               );;end if
  83.             );;end foreach
  84.             ;;顶点数num_Pt
  85.             (setq num_Pt (length lst_FsPt))
  86.             
  87.             ;;07.如果顶点数是2个,取得左下角点【pta】,右上角点【ptb】
  88.             (setq 07i nil)
  89.             (setq 07j nil)
  90.             (if (= (rem num_Pt 2) 0)
  91.               (progn
  92.                 (setq 07i (- (/ num_Pt 2) 1))
  93.                 (setq 07j (/ num_Pt 2))
  94.               )

  96.             );;end if
  97.             (if (and 07i 07j)
  98.               (progn
  99.                 (setq ptta (nth 07i lst_FsPt))
  100.                 (setq pttb (nth 07j lst_FsPt))
  101.                 (if (or (and (>= (angle ptta pttb) 0) (<= (angle ptta pttb) (* 0.5 pi))) (and (> (angle ptta pttb) (* 1.5 pi)) (< (angle ptta pttb) (* 2 pi))))
  102.                   (progn
  103.                     (setq pta ptta)
  104.                     (setq ptb pttb)
  105.                   )
  106.                   (progn
  107.                     (setq pta pttb)
  108.                     (setq ptb ptta)
  109.                   )
  110.                 );;end if
  111.                
  112.                 ;;=============08.获取到了板筋的两个顶点pta 和ptb后进行后续处理===============
  113.                 ;;设定窗交范围【08dd】
  114.                 (setq 08dd 180)
  115.                 ;;获得窗交的四个点【pt1 pt2 pt3 pt4】
  116.                 (setq 08ang1 (+ (* pi 0.5) (angle pta ptb)))
  117.                 (setq 08ang2 (+ (* pi 1.5) (angle pta ptb)))
  118.                 (setq pt1 (polar pta 08ang1 08dd))
  119.                 (setq pt2 (polar pta 08ang2 08dd))
  120.                 (setq pt3 (polar ptb 08ang2 08dd))
  121.                 (setq pt4 (polar ptb 08ang1 08dd))
  122.                 ;;09.获取窗交文字选择集09ss
  123.                 (setq 09cp_Lst (list pt1 pt2 pt3 pt4))
  124.                 (setq 09ssCp (ssget "CP" 09cp_Lst '((0 . "TEXT"))))
  125.                 (setq 09i 0)
  126.                
  127.                 ;;过滤出图层不对的文字和角度不对的文字***********************
  128.                 (if 09ssCp
  129.                   (progn
  130.                     (setq 09ss (ssadd))
  131.                     (repeat (sslength 09ssCp)
  132.                       ;;设定文字误差角为3°
  133.                       (setq ddang (* 3 (/ pi 180)))
  134.                       (setq 文字转角 (vla-get-Rotation (vlax-ename->vla-object (ssname 09ssCp 09i))))
  135.                       (if (and (member (cdr (assoc 8 (entget (ssname 09ssCp 09i)))) lst_BaseFsLayerTxt)  (if (< (- (angle pta ptb) ddang) 0)
  136.                             (or (> 文字转角 (- (+ (* pi 2) (angle pta ptb)) ddang)) (< 文字转角 (+ (angle pta ptb) ddang)))
  137.                             (if (> (+ (angle pta ptb) ddang) (* 2 pi))
  138.                               (or (> 文字转角 (- (angle pta ptb) ddang)) (< 文字转角 (- (+ (angle pta ptb) ddang) (* 2 pi))))
  139.                               (and (> 文字转角 (- (angle pta ptb) ddang)) (< 文字转角 (+ (angle pta ptb) ddang)))
  140.                             )
  141.                         ))
  142.                         (setq 09ss (ssadd (ssname 09ssCp 09i) 09ss))
  143.                       )
  144.                       (setq 09i (1+ 09i))
  145.                     )
  146.                   )
  147.                 )
  148.                
  149.                 ;;10.对文字选择集进行特殊处理
  150.                 (if 09ss
  151.                   (if (> (sslength 09ss) 0)
  152.                     (progn
  153.                       (setq 10i 0)
  154.                       (repeat (sslength 09ss)
  155.                         (setq text_insert_pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint (vlax-ename->vla-object (ssname 09ss 10i))))))
  156.                         (setq inters_pt (inters pta ptb text_insert_pt (polar text_insert_pt 08ang1 10) nil))
  157.                         (setq text_inserts_pt_dd (distance text_insert_pt inters_pt))
  158.                         (if (> text_inserts_pt_dd 200)
  159.                           (setq text_inserts_pt_dd (- text_inserts_pt_dd (vla-get-Height (vlax-ename->vla-object (ssname 09ss 10i)))))
  160.                           (setq text_inserts_pt_dd (+ text_inserts_pt_dd (vla-get-Height (vlax-ename->vla-object (ssname 09ss 10i)))))
  161.                         )
  162.                         (setq new_text_insert_pt (polar inters_pt (angle text_insert_pt inters_pt) text_inserts_pt_dd))
  163.                         ;;设置文字无对齐点以便直接改变插入点就可更改文字位置
  164.                         (vla-put-Alignment (vlax-ename->vla-object (ssname 09ss 10i)) 0)
  165.                         (vla-put-InsertionPoint (vlax-ename->vla-object (ssname 09ss 10i)) (vlax-3D-point new_text_insert_pt))
  166.                         (setq 10i (1+ 10i))
  167.                       );;end repeat
  168.                     )
  169.                   )
  170.                 )
  171.                
  172.                 ;;11.对钢筋进行镜像处理
  173.                 (vla-Mirror (vlax-ename->vla-object ename) (vlax-3D-point pta) (vlax-3D-point ptb))
  174.                 (vla-Delete (vlax-ename->vla-object ename))
  175.               )
  176.             );;end if
  177.           )
  178.         )
  179.       );;end if
  180.       (print)
  181.     )
  182.   )
  183. )







本帖子中包含更多资源

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

x

评分

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

查看全部评分

回复

使用道具 举报

涛涛_1048
发表于 2017-8-27 10:44 | 显示全部楼层
果断收藏了，学习学习
回复 支持 反对

使用道具 举报

蒙娜丽莎
发表于 2018-6-17 08:45 | 显示全部楼层
牛牛牛，果断收藏！
回复 支持 反对

使用道具 举报

yoyoho
发表于 2017-8-19 08:39 | 显示全部楼层
收藏了，学习学习!!!!
回复 支持 反对

使用道具 举报

ld_117
发表于 2015-2-6 15:21 | 显示全部楼层
果断收藏了
回复 支持 反对

使用道具 举报

品茗新秀
发表于 2015-2-6 20:52 | 显示全部楼层
代码太复杂了，顶顶
回复 支持 反对

使用道具 举报

sfjlx
发表于 2015-2-6 21:44 | 显示全部楼层
果断收藏了，学习学习
回复 支持 反对

使用道具 举报

彳余
发表于 2015-2-7 08:05 | 显示全部楼层
果断收藏了，学习学习
回复 支持 反对

使用道具 举报

why1025
发表于 2015-2-7 08:14 | 显示全部楼层
回复 支持 反对

使用道具 举报

海盗曹
发表于 2015-2-9 09:02 | 显示全部楼层
结构同行啊，支持
回复 支持 反对

使用道具 举报

用户3766035971
发表于 2015-2-9 19:59 | 显示全部楼层
果断收藏了，学习学习
回复 支持 反对

使用道具 举报

hpbqqq
发表于 2017-8-18 17:35 | 显示全部楼层
挺好的程序
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-19 03:37 , Processed in 0.193118 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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