柱定位程序源码
本帖最后由 springwillow 于 2012-4-12 18:51 编辑帮别人改的柱定位程序，主要功能，对柱相对于轴线尺寸大的水平标b2垂直标h2，小的标数值（按5取模数）。尺寸相等里水平取b1\b2，垂直取h1\h2。避让做的不太好，将就用吧。
(princ
"\nAuthor: bano
\n孤帆修改---命令:zbz"
)
(defun c:zbz (/ zxlayer ss sspline sszx i en)
(setq zxlayer "*AXIS*,*DOTE*")
(princ "\n-------选择需要标注的对象及所用的轴网*AXIS*,*DOTE*-------:")
(setqss(ssget)
sspline(ssadd)
sszx(ssadd)
)
;;建立标注所在的图层“定位标注”
(setq old_lay (getvar "clayer"))
(if (= (tblobjname "LAYER" "定位标注") nil)
(progn
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 3)
'(70 . 0)
(cons 2 "定位标注")
)
)
)
)
(setvar "clayer" "定位标注")
(setq i -1)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i))))
(if(wcmatch (cdr (assoc 8 (entget en))) zxlayer)
(ssadd en sszx)
)
(if(and (= (cdr (assoc 0 (entget en))) "LWPOLYLINE") (>= (cdr (assoc 90 (entget en))) 4))
(ssadd en sspline)
)
)
(setq interss (getinter (gt:ttt sszx)));获取所有轴线交点坐标
(gt:tt sspline) ;对柱进行两边标注
)
;;;------------次函数gt:getlayer---------------------------;;;
;;;----------获取点选元素所在的图层并返回图层名称----------;;;
;|(defun gt:getlayer (/ zx layer)
(setq zx nil)
(while (= zx nil)
(setq zx (entsel "\n选择轴线图层:"))
)
(setqlayer
(cdr (assoc 8 (entget (car zx))))
)
(setq zx nil)
(princ "\n选中的轴线图层是:")
(prin1 layer)
)|;
;;;-------获得传递来的四边形集合然后对两边进行标注-------------;;;
(defun gt:tt (sspline / OLDOS ss i en ptl p1 p2 p3 p4 p0 pp pz)
(setvar "CMDECHO" 0)
(setq OLDOS (getvar "OSMODE"))
(if (setq SS sspline)
(progn
(setvar "OSMODE" 0)
(setq i -1)
(repeat (sslength ss)
(setq en (ssname ss (setq i (+ 1 i))))
(setq ptl (getpline en)
p1 (car ptl)
p2 (cadr ptl)
p3 (caddr ptl)
p4 (cadddr ptl)
)
;插入轴线交点集合，查找适合的点
(setq x -1)
(repeat (length interss)
(setq pp (nth (setq x (+ 1 x)) interss))
(if (< (max(distance pp p1)(distance pp p2)(distance pp p3)(distance pp p4)) (distance p1 p3))
(setq p0 pp)
)
)
;若柱内有交点则进行标注
(if p0
(progn
(setq pz (getpz p1 p2 p3 p4))
;;根据最佳点位进行标注
(if(= pz p1)
(progn
(bz:dimaligned p4 p1 p2 p0)
(bz:dimaligned p1 p2 p3 p0)
)
)
(if(= pz p2)
(progn
(bz:dimaligned p1 p2 p3 p0)
(bz:dimaligned p2 p3 p4 p0)
)
)
(if(= pz p3)
(progn
(bz:dimaligned p2 p3 p4 p0)
(bz:dimaligned p3 p4 p1 p0)
)
)
(if(= pz p4)
(progn
(bz:dimaligned p3 p4 p1 p0)
(bz:dimaligned p4 p1 p2 p0)
)
)
)
)
)
)
)
(setvar "OSMODE" OLDOS)
(setvar "CMDECHO" 1)
(princ)
)
;;;----------次函数getpz:根据四点，求出最佳标注点----------;;;
(defun getpz (p1 p2 p3 p4 / pp1 pp2 pp3 pp4 ppz1 ppz2 ppz ppp1 ppp2 pp1y pp2y pp3y pp4y)
(setqpp1 p1
pp2 p2
pp3 p3
pp4 p4
pp1y (atoi (rtos (*(nth 1 pp1) 100) 2 0))
pp2y (atoi (rtos (*(nth 1 pp2) 100) 2 0))
pp3y (atoi (rtos (*(nth 1 pp3) 100) 2 0))
pp4y (atoi (rtos (*(nth 1 pp4) 100) 2 0))
)
;;求最高点
(if (> pp1y (max pp2y pp3y pp4y))
(setq ppz pp1)
)
(if (> pp2y (max pp1y pp3y pp4y))
(setq ppz pp2)
)
(if (> pp3y (max pp2y pp1y pp4y))
(setq ppz pp3)
)
(if (> pp4y (max pp2y pp3y pp1y))
(setq ppz pp4)
)
;;若是水平的柱，则求左上角点
(if (= ppz nil)
(progn (if (= pp1y (max pp2y pp3y pp4y))
(setq ppp1 pp1)
)
(if (= pp2y (max pp1y pp3y pp4y))
(if (= ppp1 nil) (setq ppp1 pp2) (setq ppp2 pp2))
)
(if (= pp3y (max pp2y pp1y pp4y))
(if (= ppp1 nil) (setq ppp1 pp3) (setq ppp2 pp3))
)
(if (= pp4y (max pp2y pp3y pp1y))
(if (= ppp1 nil) (setq ppp1 pp4) (setq ppp2 pp4))
)
(setq ppz (if (< (nth 0 ppp1)(nth 0 ppp2)) ppp1 ppp2))
)
)
(if ppz ppz)
)
;;; 函数 bz:dimaligned 用来实现单边的两个标注 ;;;
(defun bz:dimaligned (p1 p2 p3 p0 / point1 point2 point3 point0 p12 angle32)
(setqpoint1 p1
point2 p2
point3 p3
point0 p0
p12 (findper p0 p1 p2)
angle32 (angle point3 point2)
)
(brbz point1 p12 angle32 point2)
)
;;;次函数dxf
(defun dxf (en dxf)
(cdr(assoc dxf (entget en)))
)
;;;次函数brbz，根据point1 point2 angle32进行避让标注
(defun brbz(point1 point2 angle32 point3 / e0 p0 e w ed)
(setq distance12 (distance point1 point2))
(setq distance23 (distance point2 point3))
(cond ((and (equal distance12 distance23 5)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
(dim point1 point2 angle32 "h1" distance12)
(dim point3 point2 angle32 "h2" distance23))
((and (equal distance12 distance23 5)(> angle32 0.785))
(dim point1 point2 angle32 "b1" distance12)
(dim point3 point2 angle32 "b2" distance23))
((and (< distance12 distance23)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
(dim point1 point2 angle32 nil distance12)
(dim point3 point2 angle32 "h2" distance23)
)
((and (> distance12 distance23)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
(dim point1 point2 angle32 "h2" distance12)
(dim point3 point2 angle32 nil distance23))
((and (< distance12 distance23)(> angle32 0.785))
(dim point1 point2 angle32 nil distance12)
(dim point3 point2 angle32 "b2" distance23))
((and (> distance12 distance23)(> angle32 0.785))
(dim point1 point2 angle32 "b2" distance12)
(dim point3 point2 angle32 nil distance23))
)
) ;;end brbz
(defun dim (point1 point2 angle32 bh distance123 / )
(if (= bh nil)
(progn
(command "dimlinear"
point1
point2
"t"
;;下面if语句是对标注值进行取整
(if (< (ABS(- (* (atoi (rtos (if (> distance123 50)
(/ distance123 5)
(* distance123 20)
)
2 0
)
)
5
)
(if (> distance123 50)
distance123
(* distance123 100)
)
)) 0.5)
"<>"
(*(atoi (rtos (if(> distance123 50)
(/ distance123 5)
(* distance123 20)
)
2
0
)
)
5
)
);end if
"r"
(* (/ angle32 pi) 180.0)
(polar point1 angle32 (if (> distance123 50) 800 8 ))
));end command
(progn
(command "dimlinear"
point1
point2
"t"
bh
"r"
(* (/ angle32 pi) 180.0)
(polar point1 angle32 (if (> distance123 50) 800 8 ))
)));end command
;;获取最近画的标注，判断是否需要避让
(setq e0 (entlast)
p0 (dxf e0 11)
e (cdr (assoc -2 (tblsearch "block" (dxf e0 2))))
)
(while e
(if (= (dxf e 0) "MTEXT")
(setq w(dxf e 42)
enil
)
(setq e (entnext e))
)
)
;;根据条件进行避让
(if (> w (- distance123 1))
(progn
(setq ed (entget e0); 图元名e0的数据关联表存ed
ed (subst (cons 11
(polar(polar p0
(angle point2 point1)
(if(> distance123 50) 350 3.5)
)
angle32 (if(> distance123 50) 100 1)
)
)
(assoc 11 ed)
ed
); ; ; 更改11
ed (subst (cons 70 (logior (cdr (assoc 70 ed)) 128))(assoc 70 ed)ed); ; ; 更改70
)
(entmod ed)
)
)
)
;;; 函数 findper 根据三点坐标，找某点到其他两点形成线的垂直点 ;;;
(defun findper(p0 p1 p2 / point0 point1 point2)
(setqpoint0 p0
point1 p1
point2 p2
)
(inters (polar point0 (+(angle point1 point2)(/ pi 2)) 10) point0 point1 point2 nil)
)
;;;根据多线段名获得多线段的端点集合 ;;;
(defun getpline (plname / pts x)
(setq pts '())
(mapcar '(lambda (x)
(if (= (car x) 10)
(setq pts (cons (cdr x) pts))
)
)
(entget plname)
)
(reverse pts)
)
;;;-------获得传递来的轴线集合返回轴线端点集合-------------;;;
(defun gt:ttt (sszx / ss i en lines)
(if (setq SS sszx)
(progn
(setvar "OSMODE" 0)
(setq i -1)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i))))
(setq lines (append lines (getline en)))
)
)
)
(if lines lines)
)
;;;-------获得传递来的直线端点集合返回直线所有交点集合-----------;;;
(defun getinter(line / x y lines inter)
(setq x 0 y 2
lines line)
(setq inter '())
(repeat (- (/ (length lines) 2) 1)
(repeat (- (/ (- (length lines) x) 2) 1)
(if (inters (nth x lines)(nth (+ x 1) lines)(nth y lines)(nth (+ y 1) lines))
(setq inter (cons (inters (nth x lines)(nth (+ x 1) lines)(nth y lines)(nth (+ y 1) lines)) inter))
)
(setq y (+ y 2))
)
(setq x (+ x 2))
(setq y (+ x 2))
)
(reverse inter)
)
;;;根据直线名获得直线的两个端点集合 ;;;
(defun getline (lname / pts x )
(setq pts '())
(mapcar '(lambda (x)
(if (or (= (car x) 10) (= (car x) 11))
(setq pts (cons (3dPoint->2dPoint(cdr x)) pts))
)
)
(entget lname)
)
(reverse pts)
)
;;; 函数：3Dpoint->2Dpoint
(defun 3dPoint->2dPoint(3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))
)
这种好帖子是需要顶上去的 非常的好啊，感谢您的分享 感谢楼主分享原码程序! 开源的一定要顶！！！ 开源的一定要顶！！！ 感谢楼主分享原码程序! 谢谢楼主开源源码 下来试试，谢谢。 好东西， 开源的一定顶，来学习下，改改就可以标承台了
没有轴线的剪力墙，定位尺寸能否实现？ 原码要支持..