生成梁线命令的升级

linxiaoyun 2022.1.27 11:55 1075 0
结构设计 autolisp

原来的梁线命令,可以考虑动态调整偏心和梁宽,但存在如下问题:第一、不能自动修正端点到与柱的交点;第二、对于地下室斜交构件从柱中心画梁,总是要进行手动选择中心点;第三、当多段直梁绘制时,不能一次生成。此时得空升级这三项功能。效果如下:

原理如下:

第一:处理getbeampoint函数逻辑,使其通过按S支持选择墙柱,选择墙柱后,根据墙柱数量生成其对应中点,作为点输入坐标。

  • (defun getbeampoint( / pt1 pt2 ptlist-w x ss )
  • ;WALLLINE-L方式
  • ;Designed by 林霄云 2014年2月25日,升级2022年1月27日
  • (setvar "OSNAPZ" 1)
  • (setq ptlist-w '() pt2 nil )
  • (initget "S")
  • (setq pt1 (getpoint "\n输入梁端第一点,或按[S]选择墙柱:"))
  • (if (= pt1 "S")
  • (progn
  • (setq ss (ssget (list (cons 0 "*LINE")(cons 8 "*COL*,*墙*"))))
  • (if ss
  • (cond
  • ((= 1 (sslength ss))
  • (setq pt1 (wtou
  • (mid_vertex(get_p_vertex
  • (ssname ss 0)
  • ))))
  • ;(setq ss nil)
  • )
  • ((= 2 (sslength ss))
  • (setq pt1 (wtou
  • (mid_vertex(get_p_vertex
  • (ssname ss 0)
  • ))))
  • (setq pt2 (wtou
  • (mid_vertex(get_p_vertex
  • (ssname ss 1)
  • ))))
  • ;(setq ss nil)
  • )
  • ((setq pt1 (getpoint "\n选择对象多于两个,输入梁端第一点:")))
  • );cond
  • (setq pt1 (getpoint "\n未选择对象,输入梁端第一点:"))
  • );if ss
  • ));if s
  • (princ pt1)
  • ;(setq ptlist-w (cons pt1 ptlist-w))
  • ;(initget "S")
  • (if (and pt1 (null pt2))
  • (setq pt2 (getpoint pt1 "\n输入梁端第二点:")))
  • (if (and pt1 pt2)
  • (progn
  • (princ pt2)
  • (grdraw pt1 pt2 20 1)
  • (utow (cons pt1(cons pt2 ptlist-w)))
  • ;(reverse (mapcar '(lambda(x) (trans x 1 0)) ptlist-w)) ;返回wcs下的ptlist-w
  • );progn
  • nil
  • );if
  • )

第二:增加取交点函数,输入线段和线段栏选生成的选择集,用交点函数生成交点列表

  • (defun enss_inters (en ss / num obj1 obj2 j interpts ptlist)
  • (if ss
  • (progn
  • (setq num (sslength ss))
  • (setq obj1 (vlax-ename->vla-object en)
  • j 0
  • )
  • (while (< j num)
  • (setq obj2 (ssname ss j)
  • obj2 (vlax-ename->vla-object obj2)
  • interpts (vla-intersectwith obj1 obj2 0 )
  • interpts (vlax-variant-value interpts)
  • )
  • (if (> (vlax-safearray-get-u-bound interpts 1) 0)
  • (progn
  • (setq interpts
  • (vlax-safearray->list interpts)
  • )
  • (while (> (length interpts) 0)
  • (setq ptlist (cons (list (car interpts)
  • (cadr interpts)
  • (caddr interpts)
  • )
  • ptlist
  • )
  • )
  • (setq interpts (cdddr interpts))
  • )
  • )
  • )
  • (setq j (1+ j))
  • );while j
  • ptlist
  • ));if ss
  • )

第三,根据交点的数量,调整端点。

  • (defun adjust_end( en / pt p1 p2 n ptlist ptt L1 L2 L3)
  • (setq p1 (get-dxf 10 en)
  • p2 (get-dxf 11 en))
  • (setq ptlist (enss_inters
  • en
  • (ssget "F" (wtou (list p1 p2))(list (cons 0 "*LINE")(cons 8 "*COL*,*墙*")))
  • ))
  • (setq n (length ptlist))
  • (cond
  • ((= n 0) (princ "\n无交点,不调整"));n=0
  • ((= n 1) ;一侧有交点
  • (setq pt (car ptlist))
  • (if (<= (distance p1 pt) (distance p2 pt))
  • ;pt p2长,靠近p1,修正p1
  • (if (not (equal p1 pt 0.5)) (set-dxf en 10 pt))
  • (if (not (equal p2 pt 0.5)) (set-dxf en 11 pt))
  • );if 修正端点
  • );n=1
  • ((= n 2) ;有交点两个,计算三段长度,一般的,可以取较长段修正,重排
  • ;两端点一定是大于等于两交点长度
  • (setq ptlist (ptlistsort (cons p2 (cons p1 ptlist))))
  • (setq p1 (car ptlist) pt (cadr ptlist) ptt (caddr ptlist) p2 (cadddr ptlist))
  • ;(setq pt (car ptlist) ptt (cadr ptlist))
  • (setq L1 (distance p1 pt) L2 (distance pt ptt) L3 (distance ptt p2))
  • (cond
  • ( (and (equal 0 L1 0.1)(equal 0 L3 0.1)) (princ "\n端点与交点重合,不调整"))
  • ( (and (>= L1 L2)(>= L1 L3)) (set-dxfs en (list (list 10 p1) (list 11 pt))))
  • ( (and (>= L2 L1)(>= L2 L3)) (set-dxfs en (list (list 10 pt) (list 11 ptt))))
  • ( (and (>= L3 L1)(>= L3 L1)) (set-dxfs en (list (list 10 ptt) (list 11 p2))))
  • )
  • );n=2
  • ((= 0 (rem n 2)) ;四以上偶数,直接用交点生成直线
  • (setq ptlist (ptlistsort ptlist))
  • ;(setq pt (car ptlist) ptt (cadr ptlist))
  • (while (setq pt (car ptlist) ptt (cadr ptlist))
  • (make_line (list pt ptt) (getvar 'clayer))
  • (setq ptlist (cddr ptlist))
  • );while
  • (entdel en)
  • );n=2k
  • );cond
  • )

如果要在输入时,支持设置,那么autolisp的惯用做法是设置一个循环,同时设置一个xflag记录是否需要循环(退出循环标记),如getbeampoint修改支持前置调整默认梁宽梁高,那么该片段代码修改如下:

  • (initget "S B H")
  • (while (and xflag
  • (setq pt1 (getpoint "\n输入梁端第一点,或按[S选择墙柱/B设置梁宽/H设置梁高]:"))
  • )
  • (setq xflag nil)
  • (if (= pt1 "S")
  • (progn
  • (setq ss (ssget (list (cons 0 "*LINE")(cons 8 "*COL*,*墙*"))))
  • (if ss
  • (cond
  • ((= 1 (sslength ss))
  • (setq pt1 (wtou
  • (mid_vertex(get_p_vertex
  • (ssname ss 0)
  • ))))
  • ;(setq ss nil)
  • )
  • ((= 2 (sslength ss))
  • (setq pt1 (wtou
  • (mid_vertex(get_p_vertex
  • (ssname ss 0)
  • ))))
  • (setq pt2 (wtou
  • (mid_vertex(get_p_vertex
  • (ssname ss 1)
  • ))))
  • ;(setq ss nil)
  • )
  • ((setq pt1 (getpoint "\n选择对象多于两个,输入梁端第一点:")))
  • );cond
  • (setq pt1 (getpoint "\n未选择对象,输入梁端第一点:"))
  • );if ss
  • ));if s
  • (if (= pt1 "B")
  • (progn
  • (bwidsetup)
  • (setq xflag t)
  • ));if B
  • (if (= pt1 "H")
  • (progn
  • (bheightsetup)
  • (setq xflag t)
  • ));if H
  • );while

简单的说,进入循环前,将xflag设置t,进入循环内即设置为nil。如果是pt1=B、H,仍需循环,即在该条件下增加设置xflag=t。

Last Modified·2022年1月29日 10:20

暂无评论

您尚未登录,请先才能评论。