今天的论坛可真冷清

zyhandw

怎么修订标记的lsp加载后，提示有语法错误？
不过总结的经验很好，真是受教了！

004

cad lisp 工作经验之谈,只是标题让很多人绕道了.
难得的经验,顶起.

湜１只鱼

学习了  都是源码  支持

masterlong

发一个小程序
程序很简陋
大量使用command
还有些小瑕疵
懒得修改

;;单选或多选图元，其图层归并至指定图层。支持图元的预选择
;;选中图块时，所有同名块归并至指定图层，图块内图元图层颜色设为随层。不支持块内块的图元归并图层
;;本程序需doslib函数支持，请自行安装
;;阅读本程序，如果编辑器支持的话，建议将tab宽度设为3
;;laylist请自行更改。第13行、40行、174行
;;laylist的改变随当前图纸保存
;;QXX命令设置了程序自动跳转Q11命令的功能


请下载第一个文件

ps:
论坛代码有bug
先上传了一次
发现程序没添加加载后的命令提示
就改了以后又上传了一次
提交后显示两个文件下载
但是编辑窗口只能看到一个
没法把错误文件删除

gtj116600

图层合同，属性刷

masterlong

放一个成组刷文字的小工具
目标组与参照组文字个数应为整数倍
（实际多或少不会导致程序出错）
目标组与组之间Y坐标不能交叉
用到了NetBee大侠的排序程序

别的专业不知道
绘制电气系统图是很有用的



;;类似文字相同刷，选择一组文字为参照，成组刷新其它文字
;;阅读本程序，如果编辑器支持的话，建议将tab宽度设为3

(defun c:tb( / ttss bbss i a b av )
        (princ "\n选择参照text选集...")
        (setq ttss (ssget '((0 . "text"))))
        (setq ttss (tb文字左下角点按左右上下排序 ttss))
        (setq ttss (ss2list ttss))
        (princ "\n选择要改变的text选集...")
        (if (setq bbss (ssget '((0 . "text"))))
                (progn
                        (setq bbss (tb文字左下角点按左右上下排序 bbss))
                        (setq bbss (ss2list bbss))
                        (setq i 0)
                        (while (and (setq a (nth (rem i (length ttss)) ttss)) (setq b (nth i bbss)))
                                (setq av (cdr (assoc 1 (entget a))))
                                (entmod (subst (cons 1 av)(assoc 1 (entget b)) (entget b)))
                                (setq i (1+ i))
                        )
                )
        )
(princ)
)

;;文字左下角点按左右上下排序
;;排序目标为选择集时返回选择集；排序目标为图元组成的表时返回图元表；
(defun tb文字左下角点按左右上下排序( ss / sslist sss x )
        (cond
                ( (= (type ss) 'PICKSET)
                        (setq ss (ss2list ss))
                        (setq sslist (tb排序mian ss))
                        (setq sss (ssadd))
                        (foreach x sslist
                                (setq sss (ssadd x sss))
                        )
                )
                ( (= (type ss)        'LIST        )
                        (setq sslist (tb排序mian ss))
                )
                ( T Nil )
        )
)
(defun tb排序mian( ss / sss x box p1 p2 ssss sssss)
        (setq sss '())
        (foreach x ss
                (setq sss (cons (cdr (assoc 10 (entget x))) sss))
        )
        (setq sss (reverse sss))
        (setq ssss (NB_px_i sss (list 1 < >) 100))                        ;;误差值限定在100，基于标准字高=400
        (setq sssss '())
        (foreach x ssss
                (setq sssss (cons (nth x ss) sssss))
        )
        (reverse sssss)
)

(defun ss2list( ss / i sslist ent)
        (if (= 'PICKSET (type ss))
                (progn
                        (setq i -1)
                        (setq sslist '())
                        (repeat (sslength ss)
                                (setq ent (ssname ss (setq i (1+ i))))
                                (setq sslist (cons ent sslist))
                        )
                        (reverse sslist)
                )
                nil
        )
)

;|
NB_px 二维坐标表排序  
(NB_PX pobiao oflist di)
给表根据X Y 给定的表达式进行排序
pobiao----坐标点集合
oflist----排序条件   (list 0 > <)
                其中
                第一位 为 表示以X(0)优先还是以Y(1)优先
                第二位 为 X的排序关系
                第三位 为 Y的排序关系
di--------容差值。

从上到下从左到右，容差为0
实例：(NetBee_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) (list 1 < >) 0)
返回：((7 9) (1 6) (6 4) (7 3) (2 2) (6 2))
从上到下从左到右，容差为1
实例：(NetBee_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) (list 1 < >) 1)
返回：((7 9) (1 6) (6 4) (2 2) (6 2) (7 3))
|;

(defun NB_px( xyzlist oflist ddd / one x y e1 e2 one two oneof twoof )
        (setq one (car oflist))
        (if (= one 0)
        ;;若以X优先
                (setq         one car         ;;_X
                                two cadr         ;;_Y
                                oneof (cadr oflist)         ;;_X
                                twoof (caddr oflist)         ;;_y
                ) ;;_ 结束setq
        ;;若以Y优先
                (setq         one cadr         ;;_Y
                                two car         ;;_X
                                oneof (caddr oflist)         ;;_Y
                                twoof (cadr oflist)         ;;_X
                ) ;;_ 结束setq
        ) ;;_ 结束if
        (vl-sort xyzlist
                (function
                        (lambda (e1 e2)
                                (cond
                                        ( (> (abs (- (one e1) (one e2))) ddd )
                                                (oneof (one e1) (one e2) )         ;;_ 结束oneof
                                        )
                                        ( T
                                                (twoof (two e1) (two e2) )        ;;_ 结束twoof
                                        )
                                ) ;;_ 结束cond
                        ) ;;_ 结束lambda
                ) ;;_ 结束function
        ) ;;_ 结束vl-sort
) ;;_ 结束defun


;;坐标排序,返回坐标的ID号
(defun NB_px_i( xyzlist oflist ddd / one x y e1 e2 one two oneof twoof )
        (setq one (car oflist))
        (if (= one 0)
        ;;若以X优先
                (setq         one car         ;;_X
                                two CADR         ;;_Y
                                oneof (cadr oflist)         ;;_X
                                twoof (caddr oflist)         ;;_y
                ) ;;_ 结束setq
        ;;若以Y优先
                (setq         one cadr         ;;_Y
                                two CAR         ;;_X
                                oneof (caddr oflist)         ;;_Y
                                twoof (cadr oflist)         ;;_X
                ) ;;_ 结束setq
        ) ;;_ 结束if
        (vl-sort-i xyzlist
                (function
                        (lambda (e1 e2)
                                (cond
                                        ( (> (abs (- (one e1) (one e2))) ddd )
                                                (oneof (one e1) (one e2) )         ;;_ 结束oneof
                                        )
                                        ( T
                                                (twoof (two e1) (two e2) )        ;;_ 结束twoof
                                        )
                                ) ;;_ 结束cond
                        ) ;;_ 结束lambda
                ) ;;_ 结束function
        ) ;;_ 结束vl-sort
)

ludaweb

masterlong 发表于 2010-4-25 23:31
再来一个属性格式刷

这个属性格式刷写的真心不错，非常好用，有个小bug，就是刷新目标属性块的时候如果选到了没有属性的块，程序就会出错。

masterlong

ludaweb 发表于 2014-9-21 20:00
这个属性格式刷写的真心不错，非常好用，有个小bug，就是刷新目标属性块的时候如果选到了没有属性的块，程 ...

是的
我的程序大多数都有一些这样那样的BUG
预计10月中旬以后会有一段相对轻松的时间
届时会把我的一些程序重新整理后上传

hcj0075

masterlong 发表于 2013-5-9 23:08
发一个小程序
程序很简陋
大量使用command

这个强大啊，辛苦了

traveljin

现在换了行业画图挣钱，都忘了写程序了，还是要跟高手们学习啊