信.公布的源码合并一处，以便继续开发研究
本帖最后由 尘缘一生 于 2022-4-27 22:57 编辑说明：
本坛：7月信源码公布了，请学习7月信
http://bbs.mjtd.com/forum.php?mo ... 50&highlight=%D0%C5
信的程序，函数什么的，不好找到，为此，用点功夫【机械的】合并在一个文件。如果不允许发布，请版主删除即可。
请允许我对信的代码，道声敬意，我以后也会全部公布我的代码，向信学习。
关于信的DCL部分，没有转LISP，请去原帖下载即可。
这可能是早期的作品，似乎不是搞机械的。
我人事带式输送机设计，看我常用的
明细栏名称填写 HHV
黄明儒提示:数增 HHZ
多段线剖等高线 3Q;立柱2Q
"欢迎使用超强过滤 命令SSS"
统计立柱(m) HHT
超级格式刷SuperBrush,简称MAA
属性块爆破 Burst
插入块 MyI
连续偏移命令 MyO
对象旋转或者文字齐线:QXX
单行文字有道翻译TRS
中心标记 HHC
根据excel参数画联轴器，命令LZQ
驱动架命令 QDJ
打开含"托辊"表的excel,画托辊命令 TG
根据excel参数画滚筒，命令GT
根据excel参数画漏斗，命令LD
块编辑器 AB
单向阵列命令 SAA
AnotherCopy另类拷贝命令 COO
统一目的在于或美观或方便或消除乱码，命令:TY
DDS以当前标注为模版，建立新的标注样式
[测量坐标标注程序]zbb
常用螺栓命令 LSS
以当前Qleader标注画箭头，命令JTT
俯视或仰视图中，桁架标注弧长 Rad
弧长标注: HRR
相关命令2Q HHJB HHL HHX LZZ
连接成多段线 命令DDX
型钢截面 CSS
公差 GC
***临时隐藏命令:REE 恢复命令:空选或RE***
图层 TC GL YC DQ REE
对象随当前层 DQC
常用驱动组合 QDD
表格互换 TTT CE EC T2E E2T 本帖最后由 panliang9 于 2022-4-28 08:30 编辑
谢谢“尘缘一生” 分享好东西！！！ ;;******************************************************绘制文字
(defun 7Xin:MakeText (sText ;文字
ptBase ;基点
fHeight ;高度
sAlign ;对齐
MaxWidth ;最大宽度
/ ANGTEXT BOX EDATA TBL WIDTH
)
(setq ptBase (trans ptBase 1 0))
(cond ((= sAlign "L")
(setq tbl (list '(72 . 0) (cons 11 ptBase) '(73 . 0)))
)
((= sAlign "C")
(setq tbl (list '(72 . 1) (cons 11 ptBase) '(73 . 0)))
)
((= sAlign "R")
(setq tbl (list '(72 . 2) (cons 11 ptBase) '(73 . 0)))
)
((= sAlign "M")
(setq tbl (list '(72 . 4) (cons 11 ptBase) '(73 . 0)))
)
((= sAlign "TL")
(setq tbl (list '(72 . 0) (cons 11 ptBase) '(73 . 3)))
)
((= sAlign "TC")
(setq tbl (list '(72 . 1) (cons 11 ptBase) '(73 . 3)))
)
((= sAlign "TR")
(setq tbl (list '(72 . 2) (cons 11 ptBase) '(73 . 3)))
)
((= sAlign "ML")
(setq tbl (list '(72 . 0) (cons 11 ptBase) '(73 . 2)))
)
((= sAlign "MC")
(setq tbl (list '(72 . 1) (cons 11 ptBase) '(73 . 2)))
)
((= sAlign "MR")
(setq tbl (list '(72 . 2) (cons 11 ptBase) '(73 . 2)))
)
((= sAlign "BL")
(setq tbl (list '(72 . 0) (cons 11 ptBase) '(73 . 1)))
)
((= sAlign "BC")
(setq tbl (list '(72 . 1) (cons 11 ptBase) '(73 . 1)))
)
((= sAlign "BR")
(setq tbl (list '(72 . 2) (cons 11 ptBase) '(73 . 1)))
)
)
(setq
angText (+ (atan (cadr (getvar 'UCSXDIR)) (car (getvar 'UCSXDIR)))
0
)
)
(setq width (cdr (assoc 41 (tblsearch "style" (getvar 'textstyle)))))
(setq edata (append (list '(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 7 (getvar 'TEXTSTYLE))
(cons 40 fHeight)
(cons 10 ptBase)
(cons 1 sText)
(cons 50 angText)
(cons 41 width) ;字宽
)
tbl
)
)
(IF MaxWidth
(PROGN
(setq box (textbox edata))
(if (> (- (caadr box) (caar box)) MaxWidth)
(setq width (/ (* width MaxWidth) (- (caadr box) (caar box)))
edata (subst (cons 41 width) (assoc 41 edata) edata)
)
)
)
)
(entmakeX edata)
)
;;******************************************************绘制文字
;;;;;测试
;;;(defun C:w11 (/ FHEIGHT MAXWIDTH PTBASE SALIGN STEXT)
;;;(setq sText "文字")
;;;(setq ptBase '(0 0))
;;;(setq fHeight 3.5)
;;;(setq sAlign (getstring "\n 对齐方式："))
;;;(setq sAlign (strcase sAlign))
;;;(setq MaxWidth nil)
;;;(7Xin:MakeText sText ptBase fHeight sAlign MaxWidth)
;;;(princ)
;;;)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;仿justifytext
(defun HH:justifytextE (e sAlign)
(setq sAlign (strcase sAlign))
(setq en (entget e))
(setq box (textbox en))
(cond
((= sAlign "L")
(setq ptBase (car box))
(setq en (subst '(72 . 0) (assoc 72 en) en))
(setq en (subst '(73 . 0) (assoc 73 en) en))
)
((= sAlign "C")
(setq
ptBase (list (* (apply '+ (mapcar 'car box)) 0.5) (cadar box))
)
(setq en (subst '(72 . 1) (assoc 72 en) en))
(setq en (subst '(73 . 0) (assoc 73 en) en))
)
((= sAlign "R")
(setq ptBase (list (caadr box) (cadar box)))
(setq en (subst '(72 . 2) (assoc 72 en) en))
(setq en (subst '(73 . 0) (assoc 73 en) en))
)
((= sAlign "M")
(setq ptBase (apply 'MJ:MIDPOINT box))
(setq en (subst '(72 . 4) (assoc 72 en) en))
(setq en (subst '(73 . 0) (assoc 73 en) en))
)
((= sAlign "TL")
(setq ptBase (list (caar box) (cadadr box)))
(setq en (subst '(72 . 0) (assoc 72 en) en))
(setq en (subst '(73 . 3) (assoc 73 en) en))
)
((= sAlign "TC")
(setq ptBase (list (car (apply 'MJ:MIDPOINT box)) (cadadr box)))
(setq en (subst '(72 . 1) (assoc 72 en) en))
(setq en (subst '(73 . 3) (assoc 73 en) en))
)
((= sAlign "TR")
(setq ptBase (cadr box))
(setq en (subst '(72 . 2) (assoc 72 en) en))
(setq en (subst '(73 . 3) (assoc 73 en) en))
)
((= sAlign "ML")
(setq ptBase (list (caar box) (cadr (apply 'MJ:MIDPOINT box))))
(setq en (subst '(72 . 0) (assoc 72 en) en))
(setq en (subst '(73 . 2) (assoc 73 en) en))
)
((= sAlign "MC")
(setq ptBase (apply 'MJ:MIDPOINT box))
(setq en (subst '(72 . 1) (assoc 72 en) en))
(setq en (subst '(73 . 2) (assoc 73 en) en))
)
((= sAlign "MR")
(setq ptBase (list (caadr box) (cadr (apply 'MJ:MIDPOINT box))))
(setq en (subst '(72 . 2) (assoc 72 en) en))
(setq en (subst '(73 . 2) (assoc 73 en) en))
)
((= sAlign "BL")
(setq ptBase (car box))
(setq en (subst '(72 . 0) (assoc 72 en) en))
(setq en (subst '(73 . 1) (assoc 73 en) en))
)
((= sAlign "BC")
(setq
ptBase (list (* (apply '+ (mapcar 'car box)) 0.5) (cadar box))
)
(setq en (subst '(72 . 1) (assoc 72 en) en))
(setq en (subst '(73 . 1) (assoc 73 en) en))
)
((= sAlign "BR")
(setq ptBase (list (caadr box) (cadar box)))
(setq en (subst '(72 . 2) (assoc 72 en) en))
(setq en (subst '(73 . 1) (assoc 73 en) en))
)
)
(entmod (subst (cons 11 ptBase) (assoc 11 en) en))
)
(defun HH:justifytext (ss sAlign / E N)
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(HH:justifytextE e sAlign)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;仿justifytext
;;测试
(defun C:w11 (/ SS STR)
(setq str (list "L" "M" "R" "C" "TL" "TC" "TR" "ML" "MC" "MR" "BL" "BC" "BR"))
(setq ss (ssget))
(while (and str (getpoint))
(setq s (car str))
(setq str (cdr str))
(HH:justifytext ss s)
(princ "\n")
(princ s)
)
(princ)
) 本帖最后由 尘缘一生 于 2022-4-27 22:59 编辑
自贡黄明儒 发表于 2022-4-27 07:42
这可能是早期的作品，似乎不是搞机械的。
我人事带式输送机设计，看我常用的
明细栏名称填写 HHV
黄大师：你好。我没做任何改变，只是合并一处。重复也没甄别，目的是好进一步的去学习。
另外，因为我不是搞机械模具的，你有个源码，公差标注，我缺不敢进一步，是真不懂机械这块。
信的开发者，当和我是一个专业的，虽然我不知是谁。从前叫工民建，现在叫土木，我估计是学工民建的大师。它山之石是不是一个人呢？
但是有一点可以肯定，那就是，我指定比他们年龄还大几岁。
我也是工民建专业的，都已经忘干净了，现在是不盖真房子，弄建筑模型了，时间过的可真快。
页:
[1]