明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3619|回复: 26

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

[复制链接]
发表于 2019-10-7 20:33 | 显示全部楼层 |阅读模式
本帖最后由 小万LISP 于 2019-10-8 07:30 编辑

创建多重引线样式





本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1明经币 +1 金钱 +50 收起 理由
edata + 1 + 50 赞一个!

查看全部评分

发表于 2019-10-8 18:28 | 显示全部楼层
;新建多重引线样式:名称 引线颜色 文字颜色
(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))                )
        )
)

点评

论坛是分享和交流,如果把楼主的收费源码直接贴出,会打消楼主的积极性(亲身经历).  发表于 2019-10-14 11:34
你这样子好吗? 算不算违规咯?  发表于 2019-10-8 18:29
发表于 2019-10-8 20:13 | 显示全部楼层
(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
还望哪位帮助解释一下,文字位于标注线的上方而不是右方由哪个组码控制
   
发表于 2019-10-9 11:42 | 显示全部楼层
小万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码和实际的出入那么大,让人无语了
发表于 2019-10-8 03:43 | 显示全部楼层
发表于 2019-10-8 18:31 | 显示全部楼层
(defun c:NewMlStyle(name c-line c-txt / lst dic obj)
修正为
(defun NewMlStyle (name c-line c-txt / lst dic obj)
发表于 2019-10-8 18:52 | 显示全部楼层
http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid848609
论坛首先是讨论技术的,不是重复发帖赚积分的,
上面的链接,可以给大家参考:如何就某一话题讨论技术,共同进步.
几天之内,重复内容发帖,是不厚道的.
 楼主| 发表于 2019-10-9 06:18 | 显示全部楼层
本帖最后由 小万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
发表于 2019-10-9 08:02 | 显示全部楼层
拿楼主的代码做实践,走进 lisp 世界。
发表于 2019-10-9 16:10 | 显示全部楼层
MARK一下,学习一下
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 04:52 , Processed in 0.161964 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表