明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 9661|回复: 35

柱定位程序源码

    [复制链接]
发表于 2012-4-12 18:42:30 | 显示全部楼层 |阅读模式
本帖最后由 springwillow 于 2012-4-12 18:51 编辑

帮别人改的柱定位程序,主要功能,对柱相对于轴线尺寸大的水平标b2垂直标h2,小的标数值(按5取模数)。尺寸相等里水平取b1\b2,垂直取h1\h2。避让做的不太好,将就用吧。


  1. (princ
  2. "\nAuthor: bano
  3. \n孤帆修改---命令:zbz"
  4. )

  5. (defun c:zbz (/ zxlayer ss sspline sszx i en)
  6. (setq zxlayer "*AXIS*,*DOTE*")
  7. (princ "\n-------选择需要标注的对象及所用的轴网*AXIS*,*DOTE*-------:")
  8. (setq  ss  (ssget)
  9.   sspline  (ssadd)
  10.   sszx  (ssadd)
  11. )

  12. ;;建立标注所在的图层“定位标注”
  13. (setq old_lay (getvar "clayer"))
  14. (if (= (tblobjname "LAYER" "定位标注") nil)
  15. (progn
  16. (entmake (list
  17.     '(0 . "LAYER")
  18.     '(100 . "AcDbSymbolTableRecord")
  19.     '(100 . "AcDbLayerTableRecord")
  20.     '(6 . "CONTINUOUS")
  21.     '(62 . 3)
  22.     '(70 . 0)
  23.     (cons 2 "定位标注")
  24.    )
  25. )
  26. )
  27. )
  28. (setvar "clayer" "定位标注")

  29. (setq i -1)
  30. (repeat (sslength ss)
  31. (setq en (ssname ss (setq i (1+ i))))
  32. (if  (wcmatch (cdr (assoc 8 (entget en))) zxlayer)
  33. (ssadd en sszx)
  34. )
  35. (if  (and (= (cdr (assoc 0 (entget en))) "LWPOLYLINE") (>= (cdr (assoc 90 (entget en))) 4))
  36. (ssadd en sspline)
  37. )
  38. )
  39. (setq interss (getinter (gt:ttt sszx)));获取所有轴线交点坐标
  40. (gt:tt sspline) ;对柱进行两边标注
  41. )

  42. ;;;------------次函数gt:getlayer---------------------------;;;
  43. ;;;----------获取点选元素所在的图层并返回图层名称----------;;;
  44. ;|(defun gt:getlayer (/ zx layer)
  45. (setq zx nil)
  46. (while (= zx nil)
  47. (setq zx (entsel "\n选择轴线图层:"))
  48. )
  49. (setq  layer
  50.    (cdr (assoc 8 (entget (car zx))))
  51. )
  52. (setq zx nil)
  53. (princ "\n选中的轴线图层是:")
  54. (prin1 layer)
  55. )|;

  56. ;;;-------获得传递来的四边形集合然后对两边进行标注-------------;;;
  57. (defun gt:tt (sspline / OLDOS ss i en ptl p1 p2 p3 p4 p0 pp pz)
  58. (setvar "CMDECHO" 0)
  59. (setq OLDOS (getvar "OSMODE"))
  60. (if (setq SS sspline)
  61. (progn
  62. (setvar "OSMODE" 0)
  63. (setq i -1)
  64. (repeat (sslength ss)
  65.   (setq en (ssname ss (setq i (+ 1 i))))
  66.   (setq ptl (getpline en)
  67.    p1 (car ptl)
  68.    p2 (cadr ptl)
  69.    p3 (caddr ptl)
  70.    p4 (cadddr ptl)
  71.   )
  72.   ;插入轴线交点集合,查找适合的点
  73. (setq x -1)
  74.   (repeat (length interss)
  75.    (setq pp (nth (setq x (+ 1 x)) interss))
  76.    (if (< (max(distance pp p1)(distance pp p2)(distance pp p3)(distance pp p4)) (distance p1 p3))
  77.    (setq p0 pp)
  78.    )
  79.   )
  80.   ;若柱内有交点则进行标注
  81.   (if p0
  82.    (progn
  83.    (setq pz (getpz p1 p2 p3 p4))
  84.    ;;根据最佳点位进行标注
  85.    (if  (= pz p1)
  86.    (progn
  87.     (bz:dimaligned p4 p1 p2 p0)
  88.     (bz:dimaligned p1 p2 p3 p0)
  89.    )
  90.    )
  91.    (if  (= pz p2)
  92.    (progn
  93.     (bz:dimaligned p1 p2 p3 p0)
  94.     (bz:dimaligned p2 p3 p4 p0)
  95.    )
  96.    )
  97.    (if  (= pz p3)
  98.    (progn
  99.     (bz:dimaligned p2 p3 p4 p0)
  100.     (bz:dimaligned p3 p4 p1 p0)
  101.    )
  102.    )
  103.    (if  (= pz p4)
  104.    (progn
  105.     (bz:dimaligned p3 p4 p1 p0)
  106.     (bz:dimaligned p4 p1 p2 p0)
  107.    )
  108.    )
  109.    )
  110.   )
  111. )
  112. )
  113. )
  114. (setvar "OSMODE" OLDOS)
  115. (setvar "CMDECHO" 1)
  116. (princ)
  117. )

  118. ;;;----------次函数getpz:根据四点,求出最佳标注点----------;;;
  119. (defun getpz (p1 p2 p3 p4 / pp1 pp2 pp3 pp4 ppz1 ppz2 ppz ppp1 ppp2 pp1y pp2y pp3y pp4y)
  120. (setq  pp1 p1
  121.   pp2 p2
  122.   pp3 p3
  123.   pp4 p4
  124.   pp1y (atoi (rtos (*(nth 1 pp1) 100) 2 0))
  125.   pp2y (atoi (rtos (*(nth 1 pp2) 100) 2 0))
  126.   pp3y (atoi (rtos (*(nth 1 pp3) 100) 2 0))
  127.   pp4y (atoi (rtos (*(nth 1 pp4) 100) 2 0))
  128. )

  129. ;;求最高点
  130. (if (> pp1y (max pp2y pp3y pp4y))
  131. (setq ppz pp1)
  132. )
  133. (if (> pp2y (max pp1y pp3y pp4y))
  134. (setq ppz pp2)
  135. )
  136. (if (> pp3y (max pp2y pp1y pp4y))
  137. (setq ppz pp3)
  138. )
  139. (if (> pp4y (max pp2y pp3y pp1y))
  140. (setq ppz pp4)
  141. )
  142. ;;若是水平的柱,则求左上角点
  143. (if (= ppz nil)
  144. (progn (if (= pp1y (max pp2y pp3y pp4y))
  145.    (setq ppp1 pp1)
  146.    )
  147.    (if (= pp2y (max pp1y pp3y pp4y))
  148.    (if (= ppp1 nil) (setq ppp1 pp2) (setq ppp2 pp2))
  149.    )
  150.    (if (= pp3y (max pp2y pp1y pp4y))
  151.    (if (= ppp1 nil) (setq ppp1 pp3) (setq ppp2 pp3))
  152.    )
  153.    (if (= pp4y (max pp2y pp3y pp1y))
  154.    (if (= ppp1 nil) (setq ppp1 pp4) (setq ppp2 pp4))
  155.    )
  156. (setq ppz (if (< (nth 0 ppp1)(nth 0 ppp2)) ppp1 ppp2))
  157. )
  158. )
  159. (if ppz ppz)
  160. )

  161. ;;; 函数 bz:dimaligned 用来实现单边的两个标注 ;;;
  162. (defun bz:dimaligned (p1 p2 p3 p0 / point1 point2 point3 point0 p12 angle32)
  163. (setq  point1 p1
  164.   point2 p2
  165.   point3 p3
  166.   point0 p0
  167.   p12 (findper p0 p1 p2)
  168.   angle32 (angle point3 point2)
  169. )
  170. (brbz point1 p12 angle32 point2)
  171. )

  172. ;;;次函数dxf
  173. (defun dxf (en dxf)
  174. (cdr(assoc dxf (entget en)))
  175. )

  176. ;;;次函数brbz,根据point1 point2 angle32进行避让标注
  177. (defun brbz(point1 point2 angle32 point3 / e0 p0 e w ed)
  178. (setq distance12 (distance point1 point2))
  179.   (setq distance23 (distance point2 point3))
  180.   (cond ((and (equal distance12 distance23 5)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
  181.    (dim point1 point2 angle32 "h1" distance12)
  182.   (dim point3 point2 angle32 "h2" distance23))
  183.   ((and (equal distance12 distance23 5)(> angle32 0.785))
  184.    (dim point1 point2 angle32 "b1" distance12)
  185.   (dim point3 point2 angle32 "b2" distance23))
  186.    ((and (< distance12 distance23)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
  187.          (dim point1 point2 angle32 nil distance12)
  188.          (dim point3 point2 angle32 "h2" distance23)
  189.    )
  190.   ((and (> distance12 distance23)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
  191.    (dim point1 point2 angle32 "h2" distance12)
  192.   (dim point3 point2 angle32 nil distance23))
  193.   ((and (< distance12 distance23)(> angle32 0.785))
  194.    (dim point1 point2 angle32 nil distance12)
  195.    (dim point3 point2 angle32 "b2" distance23))
  196.   ((and (> distance12 distance23)(> angle32 0.785))
  197.    (dim point1 point2 angle32 "b2" distance12)
  198.    (dim point3 point2 angle32 nil distance23))

  199.   )

  200. ) ;;end brbz
  201. (defun dim (point1 point2 angle32 bh distance123 / )
  202.   (if (= bh nil)
  203.     (progn
  204.   (command "dimlinear"
  205.    point1
  206.    point2
  207.    "t"
  208.    ;;下面if语句是对标注值进行取整
  209.    (if (< (ABS(- (* (atoi (rtos (if (> distance123 50)
  210.           (/ distance123 5)
  211.          (* distance123 20)
  212.          )
  213.          2 0
  214.        )
  215.      )
  216.      5
  217.      )
  218.      
  219.      (if (> distance123 50)
  220.        distance123
  221.      (* distance123 100)
  222.      )
  223.    )) 0.5)
  224.    "<>"
  225.    (*  (atoi (rtos (if  (> distance123 50)
  226.        (/ distance123 5)
  227.        (* distance123 20)
  228.        )
  229.        2
  230.        0
  231.      )
  232.     )
  233.     5
  234.    )
  235.    );end if
  236.    "r"
  237.    (* (/ angle32 pi) 180.0)
  238.    (polar point1 angle32 (if (> distance123 50) 800 8 ))
  239. ));end command
  240.     (progn
  241.   (command "dimlinear"
  242.    point1
  243.    point2
  244.    "t"
  245.    bh
  246.    "r"
  247.    (* (/ angle32 pi) 180.0)
  248.    (polar point1 angle32 (if (> distance123 50) 800 8 ))
  249. )));end command


  250. ;;获取最近画的标注,判断是否需要避让
  251. (setq e0 (entlast)
  252.   p0 (dxf e0 11)
  253. e (cdr (assoc -2 (tblsearch "block" (dxf e0 2))))
  254. )
  255. (while e
  256. (if (= (dxf e 0) "MTEXT")
  257.   (setq w  (dxf e 42)
  258.    e  nil
  259.   )
  260.   (setq e (entnext e))
  261. )
  262. )
  263. ;;根据条件进行避让
  264. (if (> w (- distance123 1))
  265. (progn
  266. (setq ed (entget e0); 图元名e0的数据关联表存ed
  267. ed (subst (cons 11
  268.        (polar(polar p0
  269.          (angle point2 point1)
  270.          (if  (> distance123 50) 350 3.5)
  271.        )
  272.          angle32 (if  (> distance123 50) 100 1)
  273.        )

  274.      )
  275.      (assoc 11 ed)
  276.      ed
  277.     ); ; ; 更改11
  278. ed (subst (cons 70 (logior (cdr (assoc 70 ed)) 128))(assoc 70 ed)ed); ; ; 更改70
  279. )
  280. (entmod ed)
  281. )
  282. )
  283.   )
  284. ;;; 函数 findper 根据三点坐标,找某点到其他两点形成线的垂直点 ;;;
  285. (defun findper(p0 p1 p2 / point0 point1 point2)
  286. (setq  point0 p0
  287.   point1 p1
  288.   point2 p2
  289. )
  290. (inters (polar point0 (+(angle point1 point2)(/ pi 2)) 10) point0 point1 point2 nil)
  291. )

  292. ;;;根据多线段名获得多线段的端点集合 ;;;
  293. (defun getpline (plname / pts x)
  294. (setq pts '())
  295. (mapcar '(lambda (x)
  296.    (if (= (car x) 10)
  297.      (setq pts (cons (cdr x) pts))
  298.    )
  299.    )
  300.    (entget plname)
  301. )
  302. (reverse pts)
  303. )

  304. ;;;-------获得传递来的轴线集合返回轴线端点集合-------------;;;
  305. (defun gt:ttt (sszx / ss i en lines)
  306. (if (setq SS sszx)
  307. (progn
  308. (setvar "OSMODE" 0)
  309. (setq i -1)
  310. (repeat (sslength ss)
  311.   (setq en (ssname ss (setq i (1+ i))))
  312.   (setq lines (append lines (getline en)))
  313. )
  314. )
  315. )
  316. (if lines lines)
  317. )

  318. ;;;-------获得传递来的直线端点集合返回直线所有交点集合-----------;;;
  319. (defun getinter(line / x y lines inter)
  320. (setq x 0 y 2
  321.   lines line)
  322. (setq inter '())
  323. (repeat (- (/ (length lines) 2) 1)
  324. (repeat (- (/ (- (length lines) x) 2) 1)
  325. (if (inters (nth x lines)(nth (+ x 1) lines)(nth y lines)(nth (+ y 1) lines))
  326. (setq inter (cons (inters (nth x lines)(nth (+ x 1) lines)(nth y lines)(nth (+ y 1) lines)) inter))
  327. )
  328. (setq y (+ y 2))
  329. )
  330. (setq x (+ x 2))
  331. (setq y (+ x 2))
  332. )
  333. (reverse inter)
  334. )

  335. ;;;根据直线名获得直线的两个端点集合 ;;;
  336. (defun getline (lname / pts x )
  337. (setq pts '())
  338. (mapcar '(lambda (x)
  339.    (if (or (= (car x) 10) (= (car x) 11))
  340.      (setq pts (cons (3dPoint->2dPoint(cdr x)) pts))
  341.    )
  342.    )
  343.    (entget lname)
  344. )
  345. (reverse pts)
  346. )

  347. ;;; 函数:3Dpoint->2Dpoint

  348. (defun 3dPoint->2dPoint  (3dpt)
  349. (list (float (car 3dpt)) (float (cadr 3dpt)))
  350. )

本帖子中包含更多资源

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

x

评分

参与人数 1明经币 +1 收起 理由
tigcat + 1 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2017-8-2 13:25:34 | 显示全部楼层
这种好帖子是需要顶上去的
发表于 2020-8-23 22:57:41 | 显示全部楼层
非常的好啊,感谢您的分享
发表于 2020-8-15 21:39:25 | 显示全部楼层
感谢楼主分享原码程序!
发表于 2012-4-12 22:44:25 | 显示全部楼层
开源的一定要顶!!!
发表于 2012-4-13 06:58:55 | 显示全部楼层
开源的一定要顶!!!
发表于 2012-4-13 07:33:37 | 显示全部楼层
感谢楼主分享原码程序!
发表于 2012-4-13 08:27:34 | 显示全部楼层
谢谢楼主开源源码
发表于 2012-4-24 19:39:34 | 显示全部楼层
下来试试,谢谢。
发表于 2012-4-25 06:29:29 | 显示全部楼层
好东西,                                
发表于 2012-4-26 17:40:13 | 显示全部楼层
开源的一定顶,来学习下,改改就可以标承台了
发表于 2012-4-28 11:49:38 | 显示全部楼层

没有轴线的剪力墙,定位尺寸能否实现?

本帖子中包含更多资源

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

x
发表于 2012-4-28 11:52:55 | 显示全部楼层
原码要支持..
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-17 03:04 , Processed in 0.235550 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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