flytoday
发表于 2012-5-21 19:35:24
这个指定图层。。如果改成。在图中选择指定就非常完美~~
flytoday
发表于 2012-5-21 19:40:09
这个是字母标出来滴
wowan1314
发表于 2012-5-21 19:44:14
开源的一定要顶
flytoday
发表于 2012-5-21 20:01:37
转载一个某大师的精品之作
无源
xiaoyingzi
发表于 2012-5-21 20:50:43
本帖最后由 xiaoyingzi 于 2012-5-22 13:04 编辑
发个用楼主的改的,特点:采用鼠标框选的角点方位来定标注尺寸的位置
命令:dsz 设置图层
命令:dzz 定位标注
(defun c:dzz ( / getpline MidPof2P PtPerTo2Pts MakeDimAlign DimSyl DimtxtHeight
DimFont FontWidFactor D147 s ss n in e tpt1 tpt2 ptl p1 p2 p3 p4
ssaxis interss x p0 pp p14 p12 p141 p121 p34 p32 p341 p321
d70 d50 myerr myend oldosmode oldcmdecho)
;自定义出错函数
(defun myerr (msg)
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(setq msg(strcase msg t))
(if (wcmatch msg "*break,*cancel*,*exit*")
(princ "\n*取消*\n")
(princ (strcat "\n" msg))
)
(myend)
)
)
)
(princ)
)
;自定义结尾函数
(defun myend ()
(setvar "osmode" oldosmode)
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
)
(defun dxf (a en)
(cdr (assoc a en))
)
;根据多线段名获得多线段的端点集合
(defun getpline (plname / pts x)
(setq pts '())
(mapcar
'(lambda (x)
(if (= (car x) 10)
(setq pts (cons (cdr x) pts))
)
)
(entget plname)
)
(reverse pts)
;按(左上角,左下角,右下角,右上角)排序
(setq pts (vl-sort pts '(lambda(e1 e2) (not (> (car e1) (car e2))))))
(setq pts (vl-sort pts '(lambda(e1 e2) (not (> (cadr e1) (cadr e2))))))
(list(last pts) (cadr pts) (car pts) (caddr pts))
)
;获得点p1和p2两点的中点坐标
(defun MidPof2P (p1 p2)
(mapcar '(lambda(x y) (/ (+ x y) 2.0) ) p1 p2)
)
;获得点pt1到其pt2和pt3两点形成线的垂直点(垂足)坐标
(defun PtPerTo2Pts (pt1 pt2 pt3 / pt4 ang PerPt)
(setq ang (angle pt2 pt3)
pt4 (polar pt1 (+ ang (/ pi 2)) 1)
PerPt (inters pt1 pt4 pt2 pt3 nil)
)
)
;获得传递来的直线端点集合返回直线所有交点集合
(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 getlines (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 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)
)
;3D点转3D点
(defun 3dPoint->2dPoint(3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))
)
;判断点是否在多边形内
(defun isptinpm (pt ptl)
(equal pi(abs(apply '+(mapcar'(lambda (x y)(rem (- (angle pt x) (angle pt y)) pi))
(reverse (cdr (reverse (cons (last ptl) ptl))))
ptl
)
)
)
1e-6
)
)
(defun MakeDimAlign (d70 d50 d1 p10 p11 p13 p14 lay color / en000)
(setq en000
(list
(cons 0 "DIMENSION")
(cons 100 "AcDbEntity")
(cons 8 lay)
(cons 100 "AcDbDimension")
(cons 10 p10)
(cons 11 p11)
(cons 70 d70)
(cons 1 d1)
(cons 100 "AcDbAlignedDimension")
(cons 13 p13)
(cons 14 p14)
(cons 50 d50)
)
)
(if (= (logand d70 5) 0)
(setq en000 (append en000 (list '(100 . "AcDbRotatedDimension"))))
)
(if (/= -1 color) (setq en000 (append en000 (list (cons 62 color)))))
(if (= nil (entmake en000)) (princ "\n无法生成 Dim 实体."))
)
;标注点
(defun dimpt (dpt1 dpt2 dpt3 / d d_strLen TxtWidth)
(setq d (distance dpt1 dpt2)
d_strLen (strlen (itoa (fix (+ d 0.5))))
TxtWidth (* DimtxtHeight FontWidFactor d_strLen)
p11 (MidPof2P dpt1 dpt2)
p11 (polar p11 (angle dpt2 dpt3) (+ D147 D147 DimDistance))
)
(if (< (- d TxtWidth) 1)
(setq d70 128
p11 (polar p11 (angle dpt2 dpt1) (/ TxtWidth 2))
)
(setq d70 32)
)
(setq d50 (angle dpt1 dpt2))
(MakeDimAlign d70d50 "" dpt3 p11 dpt1 dpt2 "PUB_DIM" -1)
(princ)
)
;主程序开始
(setq olderr *error*)
(setq *error* myerr)
(setq oldcmdecho (getvar "cmdecho"))
(setq oldosmode (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq DimSyl (cdr(assoc 2(tblnext "Dimstyle" t))) ;取得当前的标注样式
DimtxtHeight (cdr(assoc 140 (tblsearch "Dimstyle" DimSyl))) ;标注样式中文字的高度
DimFont (cdr(assoc 2 (entget(cdr(assoc 340 (tblsearch "Dimstyle" DimSyl)))))) ;标注用到的字体名称
FontWidFactor (cdr (assoc 41 (tblsearch "style" DimFont))) ;文字的宽度系数
D147 (cdr(assoc 147 (tblsearch "Dimstyle" DimSyl)))) ;文字离尺寸线的距离;
;TxtWidth (* (strlen(itoa(fix (+ RealLength 0.4)))) DimtxtHeight FontWidFactor);标注字符串的实际长度
;柱层和轴线层默认设置为广厦的图层
(if (not ColumnLayer) (setq ColumnLayer "承台"))
(if (not AxisLayer) (setq AxisLayer "axis,dote,轴线"))
(setq DimDistance 800)
(setq tpt1 (getpoint "\n框选要标注的对象(以框选的方位定标注的方位):"))
(setq tpt2 (getcorner tpt1))
(if (setq s (ssget"w" tpt1 tpt2 (list (cons 0"LWPOLYLINE")(cons 8ColumnLayer))))
(progn
(setq n (sslength s) in 0)
(cond ((and (< (car tpt1) (car tpt2)) (> (cadr tpt1) (cadr tpt2))) (setq ss "1")) ;左上
((and (< (car tpt1) (car tpt2)) (< (cadr tpt1) (cadr tpt2))) (setq ss "2")) ;左下
((and (> (car tpt1) (car tpt2)) (< (cadr tpt1) (cadr tpt2))) (setq ss "3")) ;右下
((and (> (car tpt1) (car tpt2)) (> (cadr tpt1) (cadr tpt2))) (setq ss "4")) ;右上
)
(repeat n
(setq e (ssname s in) in (1+ in)
ptl (getpline e)
p1 (nth 0 ptl)
p2 (nth 1 ptl)
p3 (nth 2 ptl)
p4 (nth 3 ptl)
ssaxis (ssget "Cp" ptl (list (cons 0 "LINE") (cons 8 AxisLayer)))
)
(setq interss (getinter (getlines ssaxis)));获取所有轴线交点坐标
;插入轴线交点集合,查找适合的点
(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 (isptinpm pp ptl) (setq p0 pp))
)
(if p0
(progn
(setq
p12 (PtPerTo2Pts p0 p1 p2)
p14 (PtPerTo2Pts p0 p1 p4)
p32 (PtPerTo2Pts p0 p3 p2)
p34 (PtPerTo2Pts p0 p3 p4)
p141 (polar p14 (angle p0 p14) DimDistance)
p121 (polar p12 (angle p0 p12) DimDistance)
p341 (polar p34 (angle p0 p34) DimDistance)
p321 (polar p32 (angle p0 p32) DimDistance)
)
(cond ((= ss "1")(dimpt p1 p12 p121)(dimpt p2 p12 p121)(dimpt p1 p14 p141)(dimpt p4 p14 p141));左上
((= ss "2")(dimpt p1 p12 p121)(dimpt p2 p12 p121)(dimpt p3 p32 p321)(dimpt p2 p32 p321));左下
((= ss "3")(dimpt p3 p34 p341)(dimpt p4 p34 p341)(dimpt p3 p32 p321)(dimpt p2 p32 p321));右下
((= ss "4")(dimpt p3 p34 p341)(dimpt p4 p34 p341)(dimpt p1 p14 p141)(dimpt p4 p14 p141));右上
)
)
)
)
)
)
(myend)
(princ)
)
(defun c:dsz ()
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(setq AxisLayer (cdr(assoc 8 (entget (car (entsel "\n选取轴线所在层:"))))))
(setq ColumnLayer (cdr(assoc 8 (entget (car (entsel "\n选取要标注矩形所在层:"))))))
)
)
)
(princ)
)
springwillow
发表于 2012-5-22 13:05:51
xiaoyingzi 发表于 2012-5-21 20:50 static/image/common/back.gif
发个用楼主的改的,特点:采用鼠标框选的角点方位来定标注尺寸的位置
命令:dsz 设置图层
命令:dzz 定位 ...
不错,很好啊!
xiaodao520
发表于 2012-5-22 13:34:53
xiaoyingzi 发表于 2012-5-21 20:50 static/image/common/back.gif
发个用楼主的改的,特点:采用鼠标框选的角点方位来定标注尺寸的位置
命令:dsz 设置图层
命令:dzz 定位 ...
承台线如果是L线,能否标注呢???
xiaoyingzi
发表于 2012-5-22 14:06:52
line线不能,可以先用程序连成闭合多义线
500w008
发表于 2012-6-27 23:18:23
500w008
发表于 2012-7-26 15:40:42