首发：Lisp创建多重引线样式，完整版

小万LISP · 发表于 2019-10-7 20:33:42

本帖最后由小万LISP 于 2019-10-8 07:30 编辑

创建多重引线样式

crtrccrt · 发表于 2019-10-8 18:28:32

;新建多重引线样式：名称引线颜色文字颜色
(defun c:NewMlStyle(name c-line c-txt / lst dic obj)
(setq
name "节点图"
c-line 256
c-txt 7
c-line(ACI->MStC c-line)
c-txt(ACI->MStC c-txt)
)
;创建多重引线样式DXF组码列表
(setq lst
(list
(cons 0 "MLEADERSTYLE")
(cons 100 "AcDbMLeaderStyle")
(cons 3 name);多重引线样式名称
(cons 40 0);第一段角度(弧度)
(cons 41 0);第二段角度(弧度)
(cons 42 2);引线连接-基线间隙
(cons 43 0);基线距离数值
(cons 44 8);引线箭头大小
(cons 45 10);文字高度
(cons 90 3);最大引线点数
(cons 91 c-line);引线颜色，需换算
(cons 92 -1);引线线宽，ByLayer=-1, byblock=-2, default=-3, 0.25mm=25
(cons 93 c-txt);文字颜色，需换算
(cons 94 c-line);内容-块选项-颜色，需换算。
(cons 47 1);内容-块选项-比例。
(cons 49 1);内容-块选项-比例。
(cons 140 1);内容-块选项-比例。
(cons 142 1);多重引线的缩放比例，将多重引线缩放到布局=0
(cons 143 0);引线打断大小
(cons 170 2);内容-多重引线类型，多行文字=2，块=1
(cons 173 1);引线类型，直线=1，样条曲线=2
(cons 174 1);引线连接-连接位置-左，第一行顶部=0，第一行中间=1，文字中间=2，
(cons 175 1);文字角度，保持水平=1，按插入=0，始终正向读取=2
(cons 177 1);内容-块选项-附着，中心范围=0，插入点=1
(cons 178 1);引线连接-连接位置-右，第一行顶部=0，第一行中间=1，文字中间=2，
(cons 271 0);引线连接，水平连接=0，垂直连接=1
(cons 290 0);设置基线距离，勾选=1，取消=0
(cons 291 0);自动包含基线，勾选=1，取消=0
(cons 292 0);文字加框，勾选=1，取消=0
(cons 296 0);注释性，勾选=1，取消=0
(cons 297 0);始终左对正，勾选=1，取消=0
(cons 300 "");内容-默认文字
(cons 340 (tblobjname "LTYPE" "ByLayer"));引线线型(图元名)
(cons 341 (cdr (assoc 330 (entget (tblobjname "BLOCK" "_CLOSEDBLANK")))));引线箭头符号(图元名)
(cons 342 (tblobjname "STYLE" "3标注文字"));文字样式(图元名)
;(cons 343 (cdr (assoc 330 (entget (tblobjname "BLOCK" "_DetailCallout")))));多重引线为块时，源块类型
;源块类型:"_DetailCallout"=详细信息标注(视图编号/图纸编号)，"_TagBox"=方框，"_TagCircle"=圆，
;"_TagTriangle"=三角形，"_TagHexagon"=正六边形，"_TagSlot"=槽
;使用343组码的前提是当前图形中有需指定的块
)
)
(if (and
(setq dic (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE"));搜索多重引线样式的数据
(setq dic (cdr (assoc -1 dic)));返回多重引线样式图元名
(not (dictsearch dic name));检查欲新建样式名称是否与现有词典项目重复
(setq obj (entmakex lst));用列表创建一个新对象
)
;(dictadd 词典关键词新对象)
(dictadd dic (cdr (assoc 3 lst)) obj);将新样式添加到词典中
)
;(setvar "CMLEADERSTYLE" name);将新样式设置位当前样式
(princ)
)
;cad颜色序号->多重引线样式颜色
(defun ACI->MStC (c)
(defun color:rgb->true (r g b)
(+
(lsh (fix r) 16)
(lsh (fix g) 8)
(fix b)
)
)
(cond
((listP c) (+ -1040187392 (apply 'color:rgb->true c)) )
((= 0 c) -1056964608 )
((= 256 c) -1073741824 )
((< 0 c 256) (+ -1023410176 (color:rgb->true 0 0 c)) )
)
)

ljxkm · 发表于 2019-10-8 20:13:34

(cons 178 1);引线连接-连接位置-右，第一行顶部=0，第一行中间=1，文字中间=2，好像不能将文字置于标注线之上，还有 (cons 341 (cdr (assoc 330 (entget (tblobjname "BLOCK" "_CLOSEDBLANK")))));引线箭头符号(图元名)这一句能运行吗，有闭合空心箭头这个块吗，(defun c:NewMlStyle(name c-line c-txt / lst dic obj)含name c-line c-txt三个参数，函数里 (setq
            name "节点图"
            c-line 256
            c-txt 7
            c-line(ACI->MStC c-line)
            c-txt(ACI->MStC c-txt)
      )
这好像矛盾啊，上面的DXF码解释好像与CAD帮助里的不一致啊
我的是CAD2010
还望哪位帮助解释一下，文字位于标注线的上方而不是右方由哪个组码控制

ljxkm · 发表于 2019-10-9 11:42:50

小万LISP 发表于 2019-10-9 06:18
(cons 341 (cdr (assoc 330 (entget (tblobjname "BLOCK" "_CLOSEDBLANK")))))
能运行，而且就是你要的 ...

(cons 341 (cdr (assoc 330 (entget (tblobjname "BLOCK" "_CLOSEDBLANK"))))) 是可以运行，但应该还差些东西，多重引线标注以前一直没注意，前几天单位的有人的图纸画了这个东西，觉得还不错就开始注意，网上这东西说的不多，楼主能贴出来，还是感谢啊，不全的代码，自己慢慢补全也不错啊，只是CAD帮助里的的DXF码和实际的出入那么大，让人无语了

crtrccrt · 发表于 2019-10-8 03:43:16

http://bbs.mjtd.com/thread-180296-1-1.html
不要重复发

crtrccrt · 发表于 2019-10-8 18:31:54

(defun c:NewMlStyle(name c-line c-txt / lst dic obj)
修正为
(defun NewMlStyle (name c-line c-txt / lst dic obj)

crtrccrt · 发表于 2019-10-8 18:52:03

http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid848609
论坛首先是讨论技术的,不是重复发帖赚积分的,
上面的链接,可以给大家参考:如何就某一话题讨论技术,共同进步.
几天之内,重复内容发帖,是不厚道的.

小万LISP · 发表于 2019-10-9 06:18:30

本帖最后由小万LISP 于 2019-10-9 06:29 编辑

ljxkm 发表于 2019-10-8 20:13
(cons 178 1);引线连接-连接位置-右，第一行顶部=0，第一行中间=1，文字中间=2，好像不能将文字置于标注线 ...

(cons 341 (cdr (assoc 330 (entget (tblobjname "BLOCK" "_CLOSEDBLANK")))))
能运行，而且就是你要的空心闭合箭头

(cons 178 1);引线连接-连接位置-右，第一行顶部=0，第一行中间=1，文字中间=2，第一行加下划线=6，最后一行加下划线=5

mokson · 发表于 2019-10-9 08:02:16

拿楼主的代码做实践，走进 lisp 世界。

海盗曹 · 发表于 2019-10-9 16:10:32

MARK一下，学习一下

账号		自动登录	找回密码
密码			注册

[源码] 首发：Lisp创建多重引线样式，完整版

本帖子中包含更多资源

评分

点评