谁能找一个(或写一个)仿天正GBBL命令滴代码谢谢
如下图:只针对标注值..及相关文本有效就好哈...谢谢...
CTC 发表于 2012-5-12 11:23 static/image/common/back.gif
我刚开始操作时,标注的全局比例是9倍的...出图比例放大再缩小等后,文字好像回不到我原来操作的样子了 ...
试试这个吧 分开命令的
找到半个差不多的..要修改
(defun c:tt ()
(vl-load-com)
(setq en (car (entsel "\n选择一个尺寸标注:")))
(setq obj (vlax-Ename->Vla-Object en))
(setq old (vla-get-scalefactor obj))
(if (setq new (getreal (strcat "\n当前尺寸标注的比例系数为:<"
(rtos old)
">,请输入新的比例系数:"
)
)
)
(progn
(setq ss (ssget '((0 . "DIMENSION,LEADER"))))
(setq k 0)
(repeat (sslength ss)
(setq obj (vlax-Ename->Vla-Object (ssname ss k)))
(setq h (vla-get-textheight obj ))
(vla-put-textheight obj (* h 3.0));;3.0可以修改的
(vla-put-scalefactor obj new)
(setq k (1+ k))
)
)
)
(princ)
) 论坛会有的，继续找 看来还是天正好用 “只针对标注值..及相关文本” 是天正的标注和天正文字吗，还是cad标注和cad文字？ 又找到半个哈.....
(defun c:mysc (/ sc ss i en ent pts pt s1)
;;出错处理函数
(defun ss-errexit (msg)
(command)
(command)
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ msg)
(princ (strcat "\n错误: " msg))
)
(clos)
)
(svos)
(setq sc (getreal "\n请输入缩放比例<1.0>:"))
(if (null sc)
(setq sc 1.0)
)
(setq ss (ssget))
(setq i -1)
(setvar "OSMODE" 0)
(while (setq en (ssname ss (setq i (1+ i))))
(setq pt (ss-getencen en NIL))
(ss-en-scale en pt sc)
)
(clos)
)
(princ "\n高山流水图元中心缩放程序，命令mysc")
(princ)
;;;获取图元的视图中心
(defun ss-getencen (en onseg / Wmat Umat obj minPt maxPt)
(if (and onseg (= (getvar "WORLDUCS") 0))
(setq Wmat (gc:TMatrixFromTo 1 0)
Umat (gc:TMatrixFromTo 0 1)
)
)
(if en
(progn
(setq obj (vlax-ename->vla-object en))
(if Wmat
(vla-TransformBy obj (vlax-tmatrix Wmat))
)
(vla-GetBoundingBox obj 'minpt 'maxpt)
(setq minPt (vlax-safearray->list minPt))
(setq maxPt (vlax-safearray->list maxPt))
(if Umat
(vla-TransformBy obj (vlax-tmatrix Umat))
)
(midpt minpt maxpt)
)
)
)
;;;gile
(defun gc:TMatrixFromTo (from to)
(append
(mapcar
(function
(lambda (v o)
(append (trans v from to T) (list o))
)
)
(list '(1. 0. 0.) '(0. 1. 0.) '(0. 0. 1.))
(trans '(0. 0. 0.) to from)
)
(list '(0. 0. 0. 1.))
)
)
;;;图元基点缩放
(defun ss-en-scale (en pt sc / s1)
(setq s1 (ssadd)
s1 (ssadd en s1)
)
(vl-cmdf "_.SCALE" s1 "" pt sc)
)
;;;保存原来的设定
(defun svos ()
;;;记录初始变量
(setq gsls_oldosm (getvar "OSMODE") ;捕捉设定
gsls_oldoth (getvar "ORTHOMODE") ;正交设定
gsls_oldlye (getvar "CLAYER") ;当前层
gsls_oldclr (getvar "CECOLOR") ;当前颜色
gsls_plnwid (getvar "PLINEWID") ;线宽设定
gsls_oldltp (getvar "CELTYPE") ;保存当前线形
gsls_cmdecho (getvar "CMDECHO") ;命令形式
gsls_elev (getvar "ELEVATION")
gsls_pickstyle (getvar "PICKSTYLE")
gsls_olderr *error*
*error* ss-errexit
)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
)
;;;恢复原来的设定
(defun clos ()
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setvar "OSMODE" gsls_oldosm)
(setvar "ORTHOMODE" gsls_oldoth)
(setvar "CLAYER" gsls_oldlye)
(setvar "CECOLOR" gsls_oldclr)
(setvar "CELTYPE" gsls_oldltp)
(setvar "ELEVATION" gsls_elev)
(setvar "CMDECHO" gsls_cmdecho)
(setvar "PLINEWID" gsls_plnwid)
(setvar "PICKSTYLE" gsls_pickstyle)
(setq *error* gsls_olderr)
(prin1)
)
;;;求两点中点
(defun midpt (pta ptb)
(mapcar (function (lambda (x y)
(/ (+ x y) 2.0)
)
)
pta
ptb
)
) 试试 没啥技术含量 将就可以用
cad文字没有比例 是通过改字高实现
print1985 发表于 2012-5-12 01:42 static/image/common/back.gif
试试 没啥技术含量 将就可以用
cad文字没有比例 是通过改字高实现
????????????? 你咋是乱码 那几个字应该是“请输入新的出图比例”