- 积分
- 2653
- 明经币
- 个
- 注册时间
- 2020-5-23
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
这是一个用于标注材料序号的小插件，如果哪位高手可以把它修改一下，使得【直线】和【数字圆圈属性块】成为一个整体就更完美了！
(PRINC "\n引线圆圈数字递增, 执行命令: BB ")
(Defun c:bb (/ Actdoc Addor Attball Att_Bl Att_Gjh Att_Pref
Att_Str Def_Gjh Firstpt Gjbl Gj_Id I Insertpt Mspace
Oldcmd Oldcurs Oldlay Oldos Pref Startpt Att_Addor
)
(Vl-Load-Com)
(Defun *$Myerror$* (Msg)
(Redraw)
(Setvar "Osmode" Oldos)
(Setvar "Clayer" Oldlay)
(Setvar "Cursorsize" Oldcurs)
(If Attball (Vla-Delete Attball))
(Setvar "Cmdecho" Oldcmd)
(Setq *Error* &Olderr&)
(Princ "*取消*")
(Princ)
)
(Setq &Olderr& *Error*)
(Setq *Error* *$Myerror$*)
(Setq Actdoc (Vla-Get-Activedocument (Vlax-Get-Acad-Object)))
(Setq Mspace (Vla-Get-Modelspace Actdoc))
(Setq Oldlay (Getvar "Clayer"))
(Setq Oldos (Getvar "Osmode"))
(Setq Oldcmd (Getvar "Cmdecho"))
(Setq Oldcurs (Getvar "Cursorsize"))
(Setvar "Cmdecho" 0)
(Vla-Startundomark Actdoc)
(Setq Gj_Id T)
(Setvar "Osmode" (+ 1 2 32 128 512))
(While Gj_Id
(Initget 128 "P C S B")
(Setq Gjbl (Vlax-Ldata-Get "Attball" "Gjbl"))
(If (Not Gjbl) (Setq Gjbl (Rtos (Getvar "Dimscale") 2 2)))
(Setq Pref (Vlax-Ldata-Get "Attball" "Prefix"))
(If (OR (= "" Pref) (= NIL Pref))
(Progn (Setq Pref "") (Princ "\n当前编号无前缀!"))
(Princ (Strcat "\n当前编号前缀:" Pref))
)
(Setq Addor (Vlax-Ldata-Get "Attball" "Addor"))
(If (AND ADDOR (= Addor "N"))
(Princ " 序号递减!")
(PROGN (Princ " 序号递增!") (SETQ Addor "Y"))
)
(Setq Att_Addor Addor)
(Setq Def_Gjh (Vlax-Ldata-Get "Attball" "Gjh_N"))
(If (Not Def_Gjh) (Setq Def_Gjh "1"))
(Setq Att_Str (Strcat Pref Def_Gjh))
(Setq Att_Gjh Def_Gjh)
(Setq Att_Bl (Atof Gjbl))
(Setq Att_Pref Pref)
(Setq Startpt
(Getpoint
(Strcat
"\n输入编号引出点或[改绘图比例(S)/改编号前缀(P)/递增或递减(C)/改当前序号(B)]<"
Att_Str
">:"
)
)
)
(Cond
((Or (= Startpt "S") (= Startpt "s"))
(Setq Att_Bl (Getreal (Strcat "\n请输入新的绘图比例<" Gjbl ">:")))
(If (Not Att_Bl) (Setq Att_Bl (Atof Gjbl)))
(Vlax-Ldata-Put "Attball" "Gjbl" (Rtos Att_Bl 2 2))
)
((Or (= Startpt "P") (= Startpt "p"))
(IF (= "" PREF)
(Setq Att_Pref (Getstring (Strcat "\n若需前缀,请输入编号前缀:")))
(Setq Att_Pref (Getstring (Strcat "\n若需前缀,请输入编号前缀<" Pref ">:")))
)
(If (Not Att_Pref) (Setq Att_Pref Nil))
(Vlax-Ldata-Put "Attball" "Prefix" Att_Pref)
)
((Or (= Startpt "C") (= Startpt "c"))
(Setq Att_Addor (Getstring (Strcat "\n序号是否按顺序递增<" Addor ">:")))
(If (/= (Strcase Att_Addor) "N") (Setq Att_Addor "Y"))
(Vlax-Ldata-Put "Attball" "Addor" (Strcase Att_Addor))
)
((Or (= Startpt "B") (= Startpt "b"))
(Setq Att_Gjh
(Getint
(Strcat "\n请输入新的序号[当前默认序号<" Def_Gjh ">]:")
)
)
(Vlax-Ldata-Put "Attball" "Gjh_N" (Itoa Att_Gjh))
(If (Not Att_Gjh)
(Setq Att_Str (Strcat Pref Def_Gjh))
(Setq Att_Str (Strcat Pref (Itoa Att_Gjh)))
)
)
((= (Type Startpt) 'List)
(If (Null (Tblobjname "Block" (Strcat "Lhb_No_" Att_Pref)))
(Progn
(Entmake_Att 2.5 Att_Str Att_Pref)
(Entdel (Entlast))
)
)
(Setq Insertpt (Vlax-3d-Point (Polar Startpt 0 (* Att_Bl 2.5))))
(Setq Attball (Vla-Insertblock Mspace Insertpt (Strcat "Lhb_No_" Att_Pref)
Att_Bl
Att_Bl
1
0
)
)
(Foreach I (Vlax-Safearray->List
(Vlax-Variant-Value
(Vla-Getattributes Attball)
)
)
(Vla-Put-Textstring I Att_Str) ;属性值。
(Vla-Put-Tagstring I "A") ;属性块的标记。如果把"A"改成变量不带双引号的Att_Str，那标记也会随着属性值变化。
(If (> (Strlen Att_Str) 2) (Vla-Put-Scalefactor I 0.5)
)
)
(View_Gj Attball Startpt Att_Bl)
(Setq Attball Nil)
(If (/= (Strcase Att_Addor) "N")
(Progn
(Setq Def_Gjh (Itoa (1+ (Atoi Def_Gjh))))
(Vlax-Ldata-Put "Attball" "Gjh_N" Def_Gjh)
)
(Progn
(Setq Def_Gjh (Itoa (1- (Atoi Def_Gjh))))
(If (< (Atoi Def_Gjh) 0)
(Progn (Setq Def_Gjh "0")
(Princ "\n*** 编号不能为负数! ***")
)
)
(Vlax-Ldata-Put "Attball" "Gjh_N" Def_Gjh)
)
); END IF
) ; End TYPE
(View_Gj Attball Startpt Att_Bl)
(Setq Attball Nil)
(If (/= (Strcase Att_Addor) "N")
(Progn
(Setq Def_Gjh (Itoa (1+ (Atoi Def_Gjh))))
(Vlax-Ldata-Put "Attball" "Gjh_N" Def_Gjh)
)
(Progn
(Setq Def_Gjh (Itoa (1- (Atoi Def_Gjh))))
(If (< (Atoi Def_Gjh) 0)
(Progn (Setq Def_Gjh "0")
(Princ "\n*** 编号不能为负数! ***")
)
)
(Vlax-Ldata-Put "Attball" "Gjh_N" Def_Gjh)
)
) ;End Type
(T (Setq Gj_Id Nil) (PRINC "\n无效的选择或者输入!请重新确认."))
)
)
(Setvar "Clayer" Oldlay)
(Setvar "Cursorsize" Oldcurs)
(Vla-Endundomark Actdoc)
(Setvar "Osmode" Oldos)
(Setvar "Cmdecho" Oldcmd)
(Setq *Error* &Olderr&)
(Princ)
)
(DEFUN VIEW_GJ (VOBJ VBASEPT VBL / DIST FIRSTPT
LOOP_ID NEWCENPT PT1 PT10 PT11
PT12 PT2 PT3 PT4 PT5 PT6
PT7 PT8 PT9 VANGLE VPOINT VPOINTENT
MOVEPT)
(SETQ LOOP_ID T)
(SETQ ALPHA 0)
(SETVAR "CURSORSIZE" 1) ;将光标大小设置为1，最小尺寸
(PRINC "\n请输入编号标注点:")
(WHILE LOOP_ID
(SETQ VPOINTENT (GRREAD T 4 1))
(IF (= 5 (CAR VPOINTENT)) ;鼠标跟踪
(PROGN
(REDRAW)
(SETQ VPOINT (CADR VPOINTENT))
(SETQ MOVEPT VPOINT) ;记录直线第二点
(SETQ DIST (DISTANCE VBASEPT VPOINT))
(SETQ VANGLE (ANGLE VBASEPT VPOINT))
(SETQ NEWCENPT (POLAR VBASEPT VANGLE (+ DIST (* VBL 2.5))))
(SETQ FIRSTPT (Vlax-3d-Point NEWCENPT))
(VLA-PUT-INSERTIONPOINT VOBJ FIRSTPT)
(GRVECS (LIST 2 VBASEPT VPOINT))
(SETQ PT1 (POLAR VPOINT (+ ALPHA (* PI 0.5)) (* VBL 1.0))
PT2 (POLAR VPOINT (+ ALPHA (/ (* PI 7) 6)) (* VBL 1.0))
PT3 (POLAR VPOINT (+ ALPHA (/ (* PI 11) 6)) (* VBL 1.0))
PT4 (POLAR VPOINT (+ ALPHA (/ (* PI 5) 6)) (* VBL 0.268))
PT5 (POLAR VPOINT (+ ALPHA (* PI 1.5)) (* VBL 0.268))
PT6 (POLAR VPOINT (+ ALPHA (/ PI 6)) (* VBL 0.268))
)
(GRVECS (LIST 1 PT1 VPOINT 1 PT2 VPOINT
1 PT3 VPOINT 6 PT4 VPOINT
6 PT5 VPOINT 6 PT6 VPOINT
6 PT1 PT4 6 PT4 PT2 6
PT2 PT5 6 PT5 PT3 6 PT3
PT6 6 PT6 PT1)
)
(SETQ PT7 (POLAR VBASEPT (+ ALPHA (* PI 0.5)) (* VBL 1.0))
PT8 (POLAR VBASEPT (+ ALPHA (/ (* PI 7) 6)) (* VBL 1.0))
PT9 (POLAR VBASEPT (+ ALPHA (/ (* PI 11) 6)) (* VBL 1.0))
PT10 (POLAR VBASEPT (+ ALPHA (/ (* PI 5) 6)) (* VBL 0.268))
PT11 (POLAR VBASEPT (+ ALPHA (* PI 1.5)) (* VBL 0.268))
PT12 (POLAR VBASEPT (+ ALPHA (/ PI 6)) (* VBL 0.268))
)
(GRVECS (LIST 1 PT7 VBASEPT 1 PT8
VBASEPT 1 PT9 VBASEPT
5 PT10 VBASEPT 5 PT11
VBASEPT 5 PT12 VBASEPT
5 PT7 PT10 5 PT10 PT8
5 PT8 PT11 5 PT11 PT9
5 PT9 PT12 5 PT12 PT7)
)
(SETQ ALPHA (+ ALPHA (* PI 0.084)))
)
)
(IF (OR (= 3 (CAR VPOINTENT))
(= 2 (CAR VPOINTENT))
(= 11 (CAR VPOINTENT))
)
(PROGN
(REDRAW)
(SETQ LOOP_ID NIL)
(SETVAR "CLAYER" "符号")
(SETQ STARTPT (Vlax-3d-Point VBASEPT))
(SETQ ENDPT (Vlax-3d-Point MOVEPT))
(VLA-ADDLINE MSPACE STARTPT ENDPT)
)
)
) ;END WHILE
(SETVAR "CURSORSIZE" OLDCURS)
(PRINC)
) ;DEFUN VIEW_GJ
(DEFUN ENTMAKE_ATT (CIRRAD TEXT PREFIX / CHK_LAYER CHK_STYLE BLKNAME BLKN LST0
LST1)
(SETQ CHK_LAYER (TBLSEARCH "LAYER" "符号"))
(IF (= CHK_LAYER NIL)
(PROGN
(ENTMAKE (LIST
'(0 . "LAYER") ;对象类型：图层
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "continuous") ;线型
'(62 . 2) ;颜色
'(70 . 0) ;图层状态
(CONS 2 "符号") ;图层名称
)
)
)
)
(SETQ CHK_LAYER (TBLSEARCH "LAYER" "编号"))
(IF (= CHK_LAYER NIL)
(PROGN
(ENTMAKE (LIST
'(0 . "LAYER") ;对象类型：图层
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "continuous") ;线型
'(62 . 6) ;颜色
'(70 . 0) ;图层状态
'(2 . "编号") ;图层名称
)
)
)
)
(SETQ CHK_STYLE (TBLSEARCH "STYLE" "NUM_STYLE"))
(IF (= CHK_STYLE NIL)
(ENTMAKE (LIST
'(0 . "STYLE") ;对象类型：文字样式
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbTextStyleTableRecord") ;子类标记
'(2 . "NUM_STYLE") ;文字样式名称
'(70 . 0) ;标注位码
'(40 . 0.0) ;文字高度
'(41 . 0.7) ;文字宽度比例
'(50 . 0.0) ;文字倾斜角度
'(71 . 0) ;文字生成标志2＝文字反向，4＝文字颠倒
'(3 . "TSSDENG.shx") ;西文字体文件名
'(4 . "TSSDCHN.shx") ;中文字体文件名
) ;_ 结束LIST
) ;_ 结束ENTMAKE
) ;_ 结束IF
(SETQ BLKNAME (Strcat "Lhb_No_" PREFIX))
(ENTMAKE
(LIST '(0 . "BLOCK") ;对象类型：块
(CONS 2 BLKNAME) ;图块名称
'(70 . 2) ;设置属性块是否可以编辑
'(10 0.0 0.0 0.0)) ;基准点
)
(ENTMAKE (LIST '(0 . "CIRCLE") ;对象类型：圆
'(100 . "AcDbEntity")
'(67 . 0) ;0表示图元位于模型空间中
'(8 . "符号") ;图层名称
'(100 . "CIRCLE") ;
'(10 0.0 0.0 0.0) ;中心点
(CONS 40 CIRRAD) ;半径
'(210 0.0 0.0 1.0) ;拉伸方向（可选；默认值 = 0, 0, 1）
)
)
(ENTMAKE (LIST '(0 . "ATTDEF") ;对象类型：属性块
'(100 . "AcDbEntity")
'(67 . 0) ;0表示图元位于模型空间中
'(8 . "编号") ;图层名称
'(100 . "AcDbText")
'(10 -1.08 -1.75 0.0) ;文字起点
(CONS 40 (+ CIRRAD 1.0)) ;文字高度
'(1 . "A") ;默认值
'(50 . 0) ;文字旋转角度（可选；默认值 = 0）
'(41 . 0.7) ;文字宽度比例
'(51 . 0.0) ;倾斜角度（可选；默认值 = 0）
'(7 . "NUM_STYLE") ;文字样式名称
'(71 . 0) ;文字生成标志
'(72 . 1) ;文字水平对齐类型
'(11 0.0 0.0 0.0) ;对齐点，只有在72与74非0才有意义
'(210 0.0 0.0 1.0) ;拉伸方向（可选；默认值 = 0, 0, 1）
'(100 . "AcDbAttributeDefinition")
'(3 . "编号属性") ;提示字符串
'(2 . "A") ;标记字符串
'(70 . 0) ;属性标记：1 = 属性不可见（不出现）；2 = 固定属性；4 = 输入属性时要求进行验证；8 = 属性为预置（插入时无提示）；
'(73 . 0) ;字段长度（可选；默认值 = 0）
'(74 . 2) ;文字垂直对齐类型：0 = 基线对正；1 = 底端对正；2 = 居中对正；3 = 顶端对正；
)
)
(SETQ BLKN (ENTMAKE '((0 . "ENDBLK")))) ;图元类型：ENDBLK
(SETQ LST0 (LIST '(0 . "INSERT") ;对象类型：插入点
'(100 . "AcDbEntity")
'(67 . 0) ;0表示图元位于模型空间中
'(8 . "符号") ;图层
'(100 . "AcDbBlockReference")
'(66 . 1) ;可变属性跟随标志（可选；默认值 = 0）；如果属性跟随标志的值为 1，则跟随插入的将是一系列属性图元，并以一个 seqend 图元终止。
'(10 0.0 0.0 0.0);插入点
'(41 . 1.0) ;x（可选；默认值 = 1）
'(42 . 1.0) ;y（可选；默认值 = 1）
'(43 . 1.0) ;z（可选；默认值 = 1）
'(50 . 0.0) ;旋转角度（可选；默认值 = 0）
'(70 . 0) ;插入行数（可选；默认值 = 1）
'(71 . 0) ;插入列数（可选；默认值 = 1）
'(44 . 0.0) ;行间距（可选；默认值 = 0）
'(45 . 0.0) ;列间距（可选；默认值 = 0）
'(210 0.0 0.0 1.0)) ;拉伸方向（可选；默认值 = 0, 0, 1）
)
(SETQ LST1 (APPEND LST0 (LIST (CONS 2 BLKN))))
(ENTMAKE LST1)
(ENTMAKE (LIST '(0 . "ATTRIB") ;对象类型：属性
'(5 . "26")
'(100 . "AcDbEntity")
'(67 . 0) ;0表示图元位于模型空间中
'(8 . "编号") ;图层名称
'(100 . "AcDbText")
'(10 -1.08 -1.75 0.0) ;文字起点
(CONS 40 (+ CIRRAD 1.0)) ;文字高度
'(1 . "A") ;默认值
;(CONS 1 TEXT) ;默认值
'(50 . 0) ;文字旋转角度
'(41 . 0.7) ;文字宽度比例
'(51 . 0.0) ;倾斜角度
'(7 . "NUM_STYLE") ;文字样式名称
'(71 . 0) ;文字生成标志
'(72 . 1) ;文字水平对齐类型
'(11 0.0 0.0 0.0) ;对齐点，只有在72与74非0才有意义
'(210 0.0 0.0 1.0) ;拉伸方向（可选；默认值 = 0, 0, 1）
'(100 . "AcDbAttribute")
'(2 . "A") ;标记字符串
;(CONS 2 TEXT) ;标记字符串
'(70 . 0) ;属性标记：1 = 属性不可见（不出现）；2 = 固定属性；4 = 输入属性时要求进行验证；8 = 属性为预置（插入时无提示）；
'(73 . 0) ;字段长度
'(74 . 2) ;文字垂直对齐类型
)
)
(ENTMAKE '((0 . "SEQEND")))
(PRINC)
)
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？注册
x
评分
-
查看全部评分
|
发表于 2024-3-18 11:40
置顶卡
变色卡
显身卡
楼主