SummerDawn

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

原理如下：

第一：处理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

生成梁线命令的升级

评论列表