画梁时，在梁线中间自动标上梁截面（200x600）

OWEN7

rt，请高手帮忙写一个这样的lisp，。我也在酝酿中，欢迎提供思路

完整武器

帮顶一下

OWEN7

顶一个，慢慢来吧。

xyp1964

flytoday

院长如果能将集中标注与原位标注断面直接搞到梁边上那才牛B

夏生生

自己改改，例如梁宽的设置当高度大于某值时取某值，根据习惯自己改
；；；回复网友点评
本来就不是用来画梁的程序，用sap2000的自然知道本程序的妙用，呵呵。梁宽的判断很简单，加个cons即可，不同单位不同工程对梁宽有不同的要求，只是初定截面罢了

2. ;;;&&&&&&&&&&开始获取所有图层列表函数&&&&&&&&&&
   
3. (defun get_layer_list( / lay_name layer_list)
   
4.   (setq layer_list nil)
   
5.   (while (setq lay_name (cdr (assoc 2 (tblnext "layer"))))
   
6.     (setq layer_list (cons lay_name layer_list))
   
7.     )
   
8.   (tblnext "layer" t)
   
9.   layer_list
   
10.   )
    
11. ;;; &&&&&&&&&&开始检查是否存在图层，如无创建之函数&&&&&&&&&&
    
12. ;;; =============================================
    
13. ;;;      通用函数  检查是否存在图层，如无创建之
    
14. ;;; 参数：l_p------打印标志(整型) 如果设置为 0，则不打印此图层
    
15. ;;;      l_l------线型(字符串)
    
16. ;;;      l_s------图层状态(整型)
    
17. ;;;      l_n------图层名(字符串)
    
18. (defun ly_mak (l_p l_l l_s l_n / L_C)
    
19.   (SETQ L_C(LENGTH (VL-REMOVE-IF-NOT '(LAMBDA (X)(wcmatch  X "*0X*0"))(get_layer_list))))
    
20.   (if (= (tblobjname "LAYER" l_n) nil)
    
21.     (progn
    
22.       (entmake (list (cons 0 "LAYER")
    
23.                      (cons 100 "AcDbSymbolTableRecord")
    
24.                      (cons 100 "AcDbLayerTableRecord")
    
25.                      (if l_p
    
26.                        (cons 290 l_p)
    
27.                        '(290 . 1)
    
28.                      )                        ; _ 结束if
    
29.                      (if l_l
    
30.                        (cons 6 l_l)
    
31.                        '(6 . "CONTINUOUS")
    
32.                      )                        ; _ 结束if
    
33.                        (cons 62 (1+ l_c))
    
34.                      (if l_s
    
35.                        (cons 70 l_s)
    
36.                        '(70 . 0)
    
37.                      )                        ; _ 结束if
    
38.                      (cons 2 l_n)
    
39.                )                        ; _ 结束list
    
40.       )                                        ; _ 结束entmake
    
41.     )                                        ; _ 结束progn
    
42.   )                                        ; _ 结束if
    
43. 
    
44. )
    
45. ;;; _ 结束defun
    
46. ;;; &&&&&&&&&&开始创建单行文字函数&&&&&&&&&&
    
47. ;;; 参数：l_n------图层名(字符串)
    
48. ;;;      t_10------第一对齐点，如t_72或t_73非零，则该值忽略(点)
    
49. ;;;      t_t------文字本身(字符串)
    
50. ;;;      t_h------文字高度(整型)
    
51. ;;;      t_w------宽度因子(实型)
    
52. ;;;      t_st------文字样式(字符串)
    
53. ;;;      t_50------倾斜角度(整型)
    
54. ;;;      t_72------水平文字对正类型
    
55. ;;;      t_73-------垂直文字对正类型
    
56. ;;;      t_11------第二对齐点，如t_72和t_73为零，则该值忽略(点)
    
57. (defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)
    
58.   (entmake (list '(0 . "text")
    
59.                  '(100 . "AcDbEntity")
    
60.                  (cons 8 l_n)
    
61.                  '
    
62.                   (100 . "AcDbText")
    
63.                  (cons 10 t_10)
    
64.                  (cons 1 t_t)
    
65.                  (cons 40 t_h)
    
66.                  (cons 41 t_w)
    
67.                  (cons 7 t_st)
    
68.                  (cons 72 t_72)
    
69.                  (cons 11 t_11)
    
70.                  (cons 50 t_50)
    
71.                  (cons 73 t_73)
    
72.            )                                ; _ 结束list
    
73.   )                                        ; _ 结束entmake
    
74. 
    
75. )
    
76. ;;; _ 结束defun
    
77. ;;;线中点平移
    
78. (defun mv_midpt (pt1 pt2 ang dist / )
    
79.   (polar (mapcar '(lambda (x) (/ x 2)) (mapcar '+ pt1 pt2)) ang dist)
    
80.   )
    
81. (defun c:yjk( / pt1 pt2 ang dist b h l_n)
    
82.   (SETVAR "OSMODE" 163)
    
83.   (WHILE
    
84.   (SETQ PT1 (GETPOINT "\n选择起始点："))
    
85.   (SETQ PT2 (GETPOINT pt1 "\n选择结束点："))
    
86.   (setq ang (angle pt1 pt2)
    
87.         dist (distance pt1 pt2)
    
88.         b 200
    
89.         h (if (< (setq h (* (fix (/ dist 12 50)) 50))400) 400  h)
    
90.         l_n (strcat (itoa b) "X" (itoa h)))
    
91.   (ly_mak nil nil nil l_n)
    
92.   (t_mak l_n '(0 0 0) (mv_midpt pt1 pt2 (+ (/ pi 2) ang) 100) l_n ang 1 0 250 0.75 "standard")
    
93.   (t_mak l_n '(0 0 0) (mv_midpt pt1 pt2 (- ang (/ pi 2)) 400) (STRCAT "梁跨"(RTOS DIST) "mm") ang 1 0 250 0.75 "standard")
    
94.   (entmake (list '(0 . "LINE") (cons 8 l_n) (cons 10 pt1)(cons 11 pt2)))
    
95.   )
    
96.   (PRINC)
    
97.   )

;;;&&&&&&&&&&开始获取所有图层列表函数&&&&&&&&&&<br /> (defun get_layer_list( / lay_name layer_list)<br />   (setq layer_list nil)<br />   (while (setq lay_name (cdr (assoc 2 (tblnext "layer"))))<br />     (setq layer_list (cons lay_name layer_list))<br />     )<br />   (tblnext "layer" t)<br />   layer_list<br />   )<br /> ;;; &&&&&&&&&&开始检查是否存在图层，如无创建之函数&&&&&&&&&&<br /> ;;; =============================================<br /> ;;;      通用函数  检查是否存在图层，如无创建之<br /> ;;; 参数：l_p------打印标志(整型) 如果设置为 0，则不打印此图层<br /> ;;;      l_l------线型(字符串)<br /> ;;;      l_s------图层状态(整型)<br /> ;;;      l_n------图层名(字符串)<br /> (defun ly_mak (l_p l_l l_s l_n / L_C)<br />   (SETQ L_C(LENGTH (VL-REMOVE-IF-NOT '(LAMBDA (X)(wcmatch  X "*0X*0"))(get_layer_list))))<br />   (if (= (tblobjname "LAYER" l_n) nil)<br />     (progn<br />       (entmake (list (cons 0 "LAYER")<br />                      (cons 100 "AcDbSymbolTableRecord")<br />                      (cons 100 "AcDbLayerTableRecord")<br />                      (if l_p<br />                        (cons 290 l_p)<br />                        '(290 . 1)<br />                      )                        ; _ 结束if<br />                      (if l_l<br />                        (cons 6 l_l)<br />                        '(6 . "CONTINUOUS")<br />                      )                        ; _ 结束if<br />                        (cons 62 (1+ l_c))<br />                      (if l_s<br />                        (cons 70 l_s)<br />                        '(70 . 0)<br />                      )                        ; _ 结束if<br />                      (cons 2 l_n)<br />                )                        ; _ 结束list<br />       )                                        ; _ 结束entmake<br />     )                                        ; _ 结束progn<br />   )                                        ; _ 结束if<br /> <br /> )<br /> ;;; _ 结束defun<br /> ;;; &&&&&&&&&&开始创建单行文字函数&&&&&&&&&&<br /> ;;; 参数：l_n------图层名(字符串)<br /> ;;;      t_10------第一对齐点，如t_72或t_73非零，则该值忽略(点)<br /> ;;;      t_t------文字本身(字符串)<br /> ;;;      t_h------文字高度(整型)<br /> ;;;      t_w------宽度因子(实型)<br /> ;;;      t_st------文字样式(字符串)<br /> ;;;      t_50------倾斜角度(整型)<br /> ;;;      t_72------水平文字对正类型<br /> ;;;      t_73-------垂直文字对正类型<br /> ;;;      t_11------第二对齐点，如t_72和t_73为零，则该值忽略(点)<br /> (defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)<br />   (entmake (list '(0 . "text")<br />                  '(100 . "AcDbEntity")<br />                  (cons 8 l_n)<br />                  '<br />                   (100 . "AcDbText")<br />                  (cons 10 t_10)<br />                  (cons 1 t_t)<br />                  (cons 40 t_h)<br />                  (cons 41 t_w)<br />                  (cons 7 t_st)<br />                  (cons 72 t_72)<br />                  (cons 11 t_11)<br />                  (cons 50 t_50)<br />                  (cons 73 t_73)<br />            )                                ; _ 结束list<br />   )                                        ; _ 结束entmake<br /> <br /> )<br /> ;;; _ 结束defun<br /> ;;;线中点平移<br /> (defun mv_midpt (pt1 pt2 ang dist / )<br />   (polar (mapcar '(lambda (x) (/ x 2)) (mapcar '+ pt1 pt2)) ang dist) <br />   )<br /> (defun c:yjk( / pt1 pt2 ang dist b h l_n)<br />   (SETVAR "OSMODE" 163)<br />   (WHILE<br />   (SETQ PT1 (GETPOINT "\n选择起始点："))<br />   (SETQ PT2 (GETPOINT pt1 "\n选择结束点："))<br />   (setq ang (angle pt1 pt2)<br />         dist (distance pt1 pt2)<br />         b 200<br />         h (if (< (setq h (* (fix (/ dist 12 50)) 50))400) 400  h)<br />         l_n (strcat (itoa b) "X" (itoa h)))<br />   (ly_mak nil nil nil l_n)<br />   (t_mak l_n '(0 0 0) (mv_midpt pt1 pt2 (+ (/ pi 2) ang) 100) l_n ang 1 0 250 0.75 "standard")<br />   (t_mak l_n '(0 0 0) (mv_midpt pt1 pt2 (- ang (/ pi 2)) 400) (STRCAT "梁跨"(RTOS DIST) "mm") ang 1 0 250 0.75 "standard")<br />   (entmake (list '(0 . "LINE") (cons 8 l_n) (cons 10 pt1)(cons 11 pt2)))<br />   )<br />   (PRINC)<br />   )

石井鱼

院长威武，很方便，真是只有想不到，没有办不到

flytoday

如果能将原位标注与集中标注拉至靠梁边来就牛B

OWEN7

有什么妙处，

风流少年时

楼主现在还在做设计吗？