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