本帖最后由 xyp1964 于 2012-8-4 14:56 编辑
此功能基本木有用
柱子缩小－尺寸不变
本帖最后由 x_s_s_1 于 2012-8-4 16:34 编辑
（仅针对楼主测试图）修改了一下，标注的位置有思路，但是实现起来比较麻烦（对我来讲），有空了再搞吧。
(vl-load-com)
;;;lst_ssn函数(lst_ssn ss)
;;;ss参数：选折集
;;;返回图元名表
(defun lst_ssn (ss / n lst)
(repeat (setq N (sslength ss))
(setq LST (cons (ssname SS (setq N (1- N))) LST))
) ;_ 结束repeat
) ;_ 结束defun
;;;计算曲线交点
(defun Curveinters (en1 en2 / pl pts)
(setq pl (vlax-invoke
(vlax-ename->vla-object en2)
'IntersectWith
(vlax-ename->vla-object en1)
acExtendNone
)
)
(while pl
(setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
pl(cdr (cdr (cdr pl)))
)
)
pts
)
;;;更改标注比例因子
(defun ch_dim_bl (en sc)
(entmod (reverse (cons (list -3
(list "acad"
'(1000 . "DSTYLE")
'(1002 . "{")
'(1070 . 144)
;DIMLFAC变量'设置线性标注测量值的比例因子
(cons 1040 sc)
'(1002 . "}")
) ;_ 结束list
) ;_ 结束list
(reverse (entget en))
)
)
)
)
(defun zsf (/ old_ly ss_all ss_dot ss_sc ss_pts pt ssets scal n)
(setvar "cmdecho" 0)
(setq old_ly (getvar "CLAYER"))
(setvar "CLAYER" "柱涂实")
(prompt "\n请选择需要进行缩放的物体:")
(setq ss_all (ssget)) ;此处可根据个人习惯增加图层(ssget'((8 . "colu,dim,sbar,dote,axis")))
(setq ss_dot (ssget "p" (list '(0 . "*line") '(8 . "轴线__点划线"))))
;此处图层根据个人习惯改
(command "._Select" ss_all "remove" ss_dot "")
(setq ss_sc (ssget "p"))
(setq ss_pts (lst_ssn ss_dot))
(setq pt (car (Curveinters (car ss_pts) (cadr ss_pts))))
(setq ssets (lst_ssn ss_sc))
(if (setq scal (getreal "\n比例因子<0.25>:"))
t
(setq scal 0.25)
)
(foreach n (lst_ssn ss_sc)
(if (or (= (cdr (assoc 8 (entget n))) "柱平法箍筋")
(= (cdr (assoc 8 (entget n))) "柱平法纵筋")
(= (cdr (assoc 8 (entget n))) "柱__钢筋标注")
)
(progn (ssdel n ss_sc) (entdel n))
)
(if (= (cdr (assoc 8 (entget n))) "柱截面标注")
(progn (vla-scaleentity
(vlax-ename->vla-object n)
(vlax-3D-point pt)
scal
)
(ch_dim_bl n 1)
)
(if (= (cdr (assoc 8 (entget n))) "柱平法截面")
(progn (vla-scaleentity
(vlax-ename->vla-object n)
(vlax-3D-point pt)
scal
)
(command "_hatch" "solid" n "")
)
)
)
)
(setvar "CLAYER" old_ly)
)
(defun c:scc ()
(zsf)
(princ)
)
本帖最后由 随梦而飞 于 2012-8-6 21:15 编辑
顶上去待高手再完善一下，注高手完善后设50明经币，让我下载
本帖最后由 水沙漠 于 2012-9-14 00:23 编辑
TO: 19楼
(prompt "\n请选择需要进行缩放的物体:")
(setq ss_all (ssget)) ;此处可根据个人习惯增加图层(ssget'((8 . "colu,dim,sbar,dote,axis")))
(setq ss_dot (ssget "p" (list '(0 . "*line") '(8 . "轴线__点划线"))));此处图层根据个人习惯改
将上述代码做类似如下修改，可增加图层的通用性
(setq ent_axis (entget (car (entsel " \n 请选择轴线图层："))))
(setq layername_axis (cdr (assoc 8 ent_axis)))
......
(setq ent_colu (entget (car (entsel " \n 请选择柱标注图层："))))
(setq layername_colu (cdr (assoc 8 ent_colu)))
(prompt "\n请选择需要进行缩放的物体:")
(setq ss_all (ssget(list'(-4 . "<or")
'(-4 . "<and") '(0 . "line,text") (cons 8 layername_axis) '(-4 . "and>")
......
'(-4 . "<and") '(0 . "line,text") (cons 8 layername_colu) '(-4 . "and>")
'(-4 . "or>")
)
)
)
(setq ss_dot (ssget "p" (list '(0 . "*line") (cons 8 layername_axis))))
......
(setq ss_colu (ssget "p" (list '(0 . "*text") (cons 8 layername_colu))))
x_s_s_1 发表于 2012-8-3 18:41 static/image/common/back.gif
严正声明！！子函数均来自明经，非本人原创，尺寸的比例由于不知道个人习惯没有处理
好用好用，谢谢
新版探索者带这个功能，命令bbl
x_s_s_1 发表于 2012-8-3 18:41 static/image/common/back.gif
严正声明！！子函数均来自明经，非本人原创，尺寸的比例由于不知道个人习惯没有处理
好像没法用
x_s_s_1 发表于 2012-8-3 18:41
严正声明！！子函数均来自明经，非本人原创，尺寸的比例由于不知道个人习惯没有处理
你好在吗能否 吧比例因子记住 ，输入一次就可以