信.公布的源码合并一处，以便继续开发研究

尘缘一生

说明：
本坛：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

谢谢  “尘缘一生” 分享好东西！！！

自贡黄明儒

;;******************************************************绘制文字
(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 07:42
这可能是早期的作品，似乎不是搞机械的。
我人事带式输送机设计，看我常用的
明细栏名称填写 HHV

黄大师：你好。我没做任何改变，只是合并一处。重复也没甄别，目的是好进一步的去学习。
     另外，因为我不是搞机械模具的，你有个源码，公差标注，我缺不敢进一步，是真不懂机械这块。
信的开发者，当和我是一个专业的，虽然我不知是谁。从前叫工民建，现在叫土木，我估计是学工民建的大师。它山之石是不是一个人呢？
但是有一点可以肯定，那就是，我指定比他们年龄还大几岁。

hhh454

我也是工民建专业的，都已经忘干净了，现在是不盖真房子，弄建筑模型了，时间过的可真快。