SLdesign V3.0 线筋钩饰

尘缘一生 · 发表于昨天 09:12

本帖最后由尘缘一生于 2025-5-5 09:47 编辑

演示三领的《线筋钩饰》部分，
应用户要求，开发集成
三领的永久免费下载地址
通过网盘分享的文件：三领设计
链接: https://pan.baidu.com/s/1W27dmj4uU2ALNeEOUtMbPA?pwd=8v21 提取码: 8v21

;;SLdesign V3.0 三领设计 V3.0集成代码
;;Modify by 尘缘一生 QQ:15290049
;;注：代码不能独立运行，需三领环境支持；仅展示原理思路,三领环境下：支持简繁英各版本CAD与浩辰
;;两点拉筋函数-----(一级)------
(defun sl:dd-lj (pa pb / d ang p1 p2 p3 p4 p5 p6 s1)
(setq s1 (slmsg "钢筋" "葵惮" "steelbar") $stj (gjjb) d (* 0.45 slbl) ang (angle pa pb))
(if (= $stj "%%130") ;根据级别，画不同弯钩
(progn
(setq pa (polar pa ang (* 0.2 d))
pb (polar pb (angle pb pa) (* 0.2 d))
p1 (polar pa (- ang 0.436332) (* 4. d))
p2 (polar pa (+ ang 3pi2) (* 1.7 d))
p3 (polar pa (+ ang pi2) (* 1.7 d))
p4 (polar pb (+ ang pi2) (* 1.7 d))
p5 (polar pb (+ ang 3pi2) (* 1.7 d))
p6 (polar pb (- ang 2.70526) (* 4. d))
)
(entmake
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")
(cons 8 s1)
(cons 62 1) (cons 100 "AcDbPolyline")
(cons 90 6)
(cons 70 0)
(cons 10 p1) (cons 40 d) (cons 41 d)
(cons 10 p2) (cons 40 d) (cons 41 d) (cons 42 -0.97)
(cons 10 p3) (cons 40 d) (cons 41 d)
(cons 10 p4) (cons 40 d) (cons 41 d) (cons 42 -0.97)
(cons 10 p5) (cons 40 d) (cons 41 d)
(cons 10 p6) (cons 40 d) (cons 41 d)
)
)
)
(progn
(setq pa (polar pa (angle pb pa) (* 1.4 d))
pb (polar pb ang (* 1.4 d))
pa (polar pa (+ ang pi2) (* slbl 0.6))
pb (polar pb (+ ang pi2) (* slbl 0.6))
)
(setq p1 (polar pa (- ang pi2) (* slbl 1.1)))
(setq p2 (polar p1 (- ang pi4) (* slbl 3.0)))
(setq p3 (polar pb (- ang pi2) (* slbl 1.1)))
(setq p4 (polar p3 (- ang 3pi4) (* slbl 3.0)))
(entmake
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 s1)
(cons 90 6) (cons 10 p2) (cons 43 d) (cons 10 p1) (cons 10 pa) (cons 10 pb) (cons 10 p3) (cons 10 p4)
)
)
)
)
)
;;两点画钢筋+p1端钩饰-----(一级)------
;;k t 左端钩 nil 右端钩
(defun sl:2pgjp1 (p1 p2 k / s1 p3 p4 p5)
(setq s1 (slmsg "钢筋" "葵惮" "steelbar") $stj (gjjb) d (* 0.45 slbl) ang (angle p1 p2))
(if (= $stj "%%130")
(progn ;左端圆钩
(setq
p3 (polar p1 (if k (+ ang pi4) (- ang pi4)) (* 4. d))
p4 (polar p3 (+ ang pi) (* 2.5 d))
)
(entmake
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")
(cons 8 s1)
(cons 100 "AcDbPolyline")
(cons 90 4)
(cons 70 0)
(cons 10 p3) (cons 40 d) (cons 41 d)
(cons 10 p4) (cons 40 d) (cons 41 d) (if k (cons 42 1.0) (cons 42 -1.0))
(cons 10 p1) (cons 40 d) (cons 41 d)
(cons 10 p2) (cons 40 d) (cons 41 d)
)
)
)
(progn ;左端斜钩
(setq p3 (polar p1 (if k (+ ang pi2) (- ang pi2)) (* slbl 1.1)))
(setq p5 (polar p3 ang (* slbl 1.1)))
(entmake
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 s1)
(cons 90 3) (cons 10 p5) (cons 43 d) (cons 10 p1) (cons 10 p2)
)
)
)
)
(entlast)
)
;线转钢筋带弯钩key型----
(defun sl:xjhz (enam key / plis p1 p2 p3 p4 ang)
(setq plis (sl:pick2pt enam (cadr (grread 5)))
p1 (car plis) p2 (cadr plis) ang (angle p1 p2)
)
(entdel enam)
(cond
((= key (slmsg "斜弯1" "弊筥1" "Diagonal Hook1")) ;左端
(sl:2pgjp1 p1 p2 t)
)
((= key (slmsg "斜弯2" "弊筥2" "Diagonal Hook2")) ;右端
(sl:2pgjp1 p2 p1 nil)
)
((= key (slmsg "斜弯3" "弊筥3" "Diagonal Hook3")) ;两端
(sl:dd-lj p1 p2)
)
((= key (slmsg "直弯" "舠" "Straight bend"))
(setq p3 (polar p1 (- ang pi2) (+ slbl slbl)))
(setq p4 (polar p2 (- ang pi2) (+ slbl slbl)))
(entmake
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 (slmsg "钢筋" "葵惮" "steelbar"))
(cons 90 4) (cons 10 p3) (cons 43 (* 0.45 slbl)) (cons 10 p1) (cons 10 p2) (cons 10 p4)
)
)
)
)
)
;;Table 循环开关(公共函数)----(一级)-----
;;lis (("k1 msg1") ("k2 msg2")....) 开关列表
;;ss 选择集 nil fun 执行函数,ss=nil fun不执行
;;返回 (list k ms) k开关字符 ms 信息
(defun sl:tabkey (lis ss fun / k ms n i return lisk str str1 elis)
(defun sl:mkelis (elis k / nam nam1 elis1)
(if (and elis (> (length elis) 0))
(while (setq nam (car elis))
(apply fun (list nam k))
(setq nam1 (entlast))
(if (eq nam1 nam)
(setq elis1 (cons nam elis1))
(setq elis1 (cons nam1 elis1))
)
(setq elis (cdr elis))
)
)
elis1
)
;;---------------------
(setq k (caar lis) ms (cadar lis) i (1- (length lis)) n 0 return (list k msg)
str (slmsg "\n->[循环切换开关(TAB)])<当前:" "\n->[碻吏ち传秨闽(TAB)])<讽玡:" "\n->[Loop switch(TAB)])<Current:")
str1 (slmsg "(其余键>退出)" "(ㄤ龄>癶)" "(Other keys>Exit)")
loop t
)
(princ (strcat str k "!!" ms ">" str1))
(if (and ss (> (sslength ss) 0)) (setq elis (sl:mkelis (ss-enlst ss) k)))
(while loop
(setq bb (grread t 15 2))
(cond
((member bb '((2 9))) ;;table 键
(if (> (setq n (1+ n)) i) (setq n 0))
(setq lisk (nth n lis) k (car lisk) ms (cadr lisk) return (list k ms))
(princ (strcat str k "!!" ms ">" str1))
(if elis (setq elis (sl:mkelis elis k)))
)
((or (= (car bb) 3) ;;左键
(member (car bb) '(11 25)) ;右键
(member bb '((2 32))) ;空格键
(member bb '((2 13))) ;;回车
)
(setq loop nil)
)
)
)
return
)
;;线筋钩饰---
(defun c:xjhz (/ sel)
(if (setq sel (entsel (slmsg "请选择钢筋线段:" "叫匡拒葵惮絬琿:" "Please select a steel bar segment:")))
(sl:tabkey (list
(list (slmsg "斜弯1" "弊筥1" "Diagonal Hook1") (slmsg "左端" "オ狠" "Left end"))
(list (slmsg "斜弯2" "弊筥2" "Diagonal Hook2") (slmsg "右端" "狠" "Right end"))
(list (slmsg "斜弯3" "弊筥3" "Diagonal Hook3") (slmsg "两端" "ㄢ狠" "Both ends"))
(list (slmsg "直弯" "舠" "Straight bend") (slmsg "直钩" "筥" "Straight hook"))
)
(ssadd (car sel))
'sl:xjhz
)
)
)

;;SLdesign V3.0 三领设计 V3.0集成代码 
;;Modify by 尘缘一生 QQ:15290049 
;;注：代码不能独立运行，需三领环境支持；仅展示原理思路,三领环境下：支持简繁英各版本CAD与浩辰 
;;两点拉筋函数-----(一级)------ 
(defun sl:dd-lj (pa pb / d ang p1 p2 p3 p4 p5 p6 s1) 
  (setq s1 (slmsg "钢筋" "葵惮" "steelbar") $stj (gjjb) d (* 0.45 slbl) ang (angle pa pb)) 
  (if (= $stj "%%130") ;根据级别，画不同弯钩 
    (progn 
      (setq pa (polar pa ang (* 0.2 d)) 
        pb (polar pb (angle pb pa) (* 0.2 d)) 
        p1 (polar pa (- ang 0.436332) (* 4. d)) 
        p2 (polar pa (+ ang 3pi2) (* 1.7 d)) 
        p3 (polar pa (+ ang pi2) (* 1.7 d)) 
        p4 (polar pb (+ ang pi2) (* 1.7 d)) 
        p5 (polar pb (+ ang 3pi2) (* 1.7 d)) 
        p6 (polar pb (- ang 2.70526) (* 4. d)) 
      ) 
      (entmake 
        (list 
          (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") 
          (cons 8 s1) 
          (cons 62 1) (cons 100 "AcDbPolyline") 
          (cons 90 6) 
          (cons 70 0) 
          (cons 10 p1) (cons 40 d) (cons 41 d) 
          (cons 10 p2) (cons 40 d) (cons 41 d) (cons 42 -0.97) 
          (cons 10 p3) (cons 40 d) (cons 41 d) 
          (cons 10 p4) (cons 40 d) (cons 41 d) (cons 42 -0.97) 
          (cons 10 p5) (cons 40 d) (cons 41 d) 
          (cons 10 p6) (cons 40 d) (cons 41 d) 
        ) 
      ) 
    ) 
    (progn 
      (setq pa (polar pa (angle pb pa) (* 1.4 d)) 
        pb (polar pb ang (* 1.4 d)) 
        pa (polar pa (+ ang pi2) (* slbl 0.6)) 
        pb (polar pb (+ ang pi2) (* slbl 0.6)) 
      ) 
      (setq p1 (polar pa (- ang pi2) (* slbl 1.1))) 
      (setq p2 (polar p1 (- ang pi4) (* slbl 3.0))) 
      (setq p3 (polar pb (- ang pi2) (* slbl 1.1))) 
      (setq p4 (polar p3 (- ang 3pi4) (* slbl 3.0))) 
      (entmake 
        (list 
          (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 s1) 
          (cons 90 6) (cons 10 p2) (cons 43 d) (cons 10 p1) (cons 10 pa) (cons 10 pb) (cons 10 p3) (cons 10 p4) 
        ) 
      ) 
    ) 
  ) 
) 
;;两点画钢筋+p1端钩饰-----(一级)------ 
;;k t 左端钩 nil 右端钩 
(defun sl:2pgjp1 (p1 p2 k / s1 p3 p4 p5) 
  (setq s1 (slmsg "钢筋" "葵惮" "steelbar") $stj (gjjb) d (* 0.45 slbl) ang (angle p1 p2)) 
  (if (= $stj "%%130") 
    (progn ;左端圆钩 
      (setq 
        p3 (polar p1 (if k (+ ang pi4) (- ang pi4)) (* 4. d)) 
        p4 (polar p3 (+ ang pi) (* 2.5 d)) 
      ) 
      (entmake 
        (list 
          (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") 
          (cons 8 s1) 
          (cons 100 "AcDbPolyline") 
          (cons 90 4) 
          (cons 70 0) 
          (cons 10 p3) (cons 40 d) (cons 41 d) 
          (cons 10 p4) (cons 40 d) (cons 41 d) (if k (cons 42 1.0) (cons 42 -1.0)) 
          (cons 10 p1) (cons 40 d) (cons 41 d) 
          (cons 10 p2) (cons 40 d) (cons 41 d) 
        ) 
      ) 
    ) 
    (progn ;左端斜钩 
      (setq p3 (polar p1 (if k (+ ang pi2) (- ang pi2)) (* slbl 1.1))) 
      (setq p5 (polar p3 ang (* slbl 1.1))) 
      (entmake 
        (list 
          (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 s1) 
          (cons 90 3) (cons 10 p5) (cons 43 d) (cons 10 p1) (cons 10 p2) 
        ) 
      ) 
    ) 
  ) 
  (entlast) 
) 
;线转钢筋带弯钩key型---- 
(defun sl:xjhz (enam key / plis p1 p2 p3 p4 ang) 
  (setq plis (sl:pick2pt enam (cadr (grread 5))) 
    p1 (car plis) p2 (cadr plis) ang (angle p1 p2) 
  ) 
  (entdel enam) 
  (cond 
    ((= key (slmsg "斜弯1" "弊筥1" "Diagonal Hook1")) ;左端 
      (sl:2pgjp1 p1 p2 t) 
    ) 
    ((= key (slmsg "斜弯2" "弊筥2" "Diagonal Hook2")) ;右端 
      (sl:2pgjp1 p2 p1 nil) 
    ) 
    ((= key (slmsg "斜弯3" "弊筥3" "Diagonal Hook3")) ;两端 
      (sl:dd-lj p1 p2) 
    ) 
    ((= key (slmsg "直弯" "舠" "Straight bend")) 
      (setq p3 (polar p1 (- ang pi2) (+ slbl slbl))) 
      (setq p4 (polar p2 (- ang pi2) (+ slbl slbl))) 
      (entmake 
        (list 
          (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 (slmsg "钢筋" "葵惮" "steelbar")) 
          (cons 90 4) (cons 10 p3) (cons 43 (* 0.45 slbl)) (cons 10 p1) (cons 10 p2) (cons 10 p4) 
        ) 
      ) 
    ) 
  ) 
) 
;;Table 循环开关(公共函数)----(一级)-----    
;;lis (("k1 msg1") ("k2 msg2")....) 开关列表 
;;ss 选择集 nil  fun 执行函数,ss=nil fun不执行 
;;返回 (list k ms) k开关字符 ms 信息 
(defun sl:tabkey (lis ss fun / k ms n i return lisk str str1 elis) 
  (defun sl:mkelis (elis k / nam nam1 elis1) 
    (if (and elis (> (length elis) 0)) 
      (while (setq nam (car elis)) 
        (apply fun (list nam k)) 
        (setq nam1 (entlast)) 
        (if (eq nam1 nam) 
          (setq elis1 (cons nam elis1)) 
          (setq elis1 (cons nam1 elis1)) 
        ) 
        (setq elis (cdr elis)) 
      ) 
    ) 
    elis1 
  ) 
  ;;--------------------- 
  (setq k (caar lis) ms (cadar lis) i (1- (length lis)) n 0 return (list k msg) 
    str (slmsg "\n->[循环切换开关(TAB)])<当前:" "\n->[碻吏ち传秨闽(TAB)])<讽玡:" "\n->[Loop switch(TAB)])<Current:") 
    str1 (slmsg "(其余键>退出)" "(ㄤ龄>癶)" "(Other keys>Exit)") 
    loop t 
  ) 
  (princ (strcat str k "!!" ms ">" str1)) 
  (if (and ss (> (sslength ss) 0)) (setq elis (sl:mkelis (ss-enlst ss) k))) 
  (while loop 
    (setq bb (grread t 15 2)) 
    (cond 
      ((member bb '((2 9))) ;;table 键 
        (if (> (setq n (1+ n)) i) (setq n 0)) 
        (setq lisk (nth n lis) k (car lisk) ms (cadr lisk) return (list k ms)) 
        (princ (strcat str k "!!" ms ">" str1)) 
        (if elis (setq elis (sl:mkelis elis k))) 
      ) 
      ((or (= (car bb) 3) ;;左键 
         (member (car bb) '(11 25)) ;右键 
         (member bb '((2 32))) ;空格键 
         (member bb '((2 13))) ;;回车 
       )    
        (setq loop nil) 
      ) 
    ) 
  ) 
  return 
) 
;;线筋钩饰--- 
(defun c:xjhz (/ sel) 
  (if (setq sel (entsel (slmsg "请选择钢筋线段:" "叫匡拒葵惮絬琿:" "Please select a steel bar segment:"))) 
    (sl:tabkey (list 
                 (list (slmsg "斜弯1" "弊筥1" "Diagonal Hook1") (slmsg "左端" "オ狠" "Left end")) 
                 (list (slmsg "斜弯2" "弊筥2" "Diagonal Hook2") (slmsg "右端" "狠" "Right end")) 
                 (list (slmsg "斜弯3" "弊筥3" "Diagonal Hook3") (slmsg "两端" "ㄢ狠" "Both ends")) 
                 (list (slmsg "直弯" "舠" "Straight bend") (slmsg "直钩" "筥" "Straight hook")) 
               ) 
      (ssadd (car sel)) 
      'sl:xjhz 
    ) 
  ) 
)

MoShuang · 发表于昨天 09:14

真吉尔好用，强烈推荐

xyp1964 · 发表于昨天 09:47

非结构大佬钢筋钩可不敢瞎改

bai2000 · 发表于昨天 11:17

(gjjb)？？？？？？

尘缘一生 · 发表于昨天 16:54

xyp1964 发表于 2025-5-5 09:47
非结构大佬钢筋钩可不敢瞎改

哪部分不是乱码，是港台地区的BIG5码，程序在港台地区CAD安装，程序会自动判定。

;;简体、繁体、英文提示---(一级)-----
;;msg1 简体字 nil msg2 繁体字 nil msg3 英文 nil--
(defun slmsg (msg1 msg2 msg3 / msg)
(cond
((= $Lgver 1)
(setq msg msg1)
)
((= $Lgver 2) ;繁体版
(setq msg msg2)
)
((= $Lgver 3)
(setq msg msg3)
)
)
msg ;;输出信息
)
;;!!!!!!!!!!!!!!!!0000级加载!!!!!!!!!!!!!!!!!!
;;(vla-put-displayscrollbars (vla-get-display (vla-get-preferences *Acad*)) 0) ;_关闭滚动条,浩辰测试错误
(if (null vlax-dump-object) (vl-load-com));;将 Visual LISP 扩展功能加载到 AutoLISP
;;常量定义
(setq *Acad* (vlax-get-acad-object)
*AcDocument* (vla-get-activedocument *Acad*)
*Model-Space* (vla-get-modelspace *AcDocument*)
*Paper-Space* (vla-get-PaperSpace *AcDocument*)
*BLKS* (vla-get-Blocks *AcDocument*)
*LAYS* (vla-get-Layers *AcDocument*)
*ACLYS* (vla-get-activeLayer *AcDocument*)
*LTS* (vla-get-Linetypes *AcDocument*)
*GRPS* (vla-get-groups *AcDocument*)
pi2 (* pi 0.5)
pi4 (* pi 0.25)
3pi4 (* 0.75 pi)
2pi (+ pi pi)
3pi2 (+ 3pi4 3pi4) ;; (* 1.5 pi)
5pi4 (+ pi pi4) ;;(* 1.25 pi)
7pi4 (+ 3pi2 pi4) ;;(* 1.75 pi)
)
;;-------
(defun sl0000 (/ kk kk1 k0 k1 k2 k3 s str path1)
;;(xlr-autolayer)防止天正崩溃(舍弃自动图层)
(setq kk1 (getvar "SYSCODEPAGE")) ;显示所在地区的代码
(cond
((= kk1 (strcase "ansi_936")) ;;CAD是简体版
(setq $Lgver 1 $hz "hz" $xz "xz" k0 "bz" str "简体中文"
$okbt ":button {label="确定";key="accept";is_default=true;}"
$canbt ":button {label="取消"; key="cancel";is_cancel=true;}"
)
)
((= kk1 (strcase "ansi_950")) ;繁体版
(setq $Lgver 2 $hz "fan" $xz "fank" k0 "ft" str "羉砰いゅ"
$okbt ":button {label="絋﹚";key="accept";is_default=true;}"
$canbt ":button {label=""; key="cancel";is_cancel=true;}"
)
)
((and (/= kk1 (strcase "ansi_936")) (/= kk1 (strcase "ansi_950"))) ;;英文或其他版
(setq $Lgver 3 $hz "hz" $xz "xz" k0 "en" str "Englishversion"
$okbt ":button {label="Accept";key="accept";is_default=true;}"
$canbt ":button {label="Cancel"; key="cancel";is_cancel=true;}"
)
)
)
(setq
$row ":cluster {horizontal_margin=none; vertical_margin=none; children_alignment=centered;"
$column ":cluster {layout=vertical;horizontal_margin=none;vertical_margin=none;"
$boxed_row ":cluster {boxed=true;children_alignment=centered;"
$boxed_column ":cluster {layout=vertical;boxed=true;"
$radio_row ":radio_cluster {horizontal_margin=none;vertical_margin=none;children_alignment=centered;"
$radio_column ":radio_cluster {layout=vertical;horizontal_margin=none;vertical_margin=none;"
$boxed_radio_row ":radio_cluster {boxed=true;children_alignment=centered;"
$boxed_radio_column ":radio_cluster {layout=vertical;boxed=true;"
)
(if (setq sl-path0 (sl-lujing))
(progn
(sl:del-path-temp (strcat sl-path0 "\" "Support" "\") '("*.bak" "*.dwl" "*.dwl2" "*.sv$" "*.log"))
(sl:del-path-temp (strcat sl-path0 "\" "Fonts" "\") '("*.bak" "*.dwl" "*.dwl2" "*.sv$" "*.log"))
(sl:del-path-temp (strcat sl-path0 "\") '("*.bak" "*.dwl" "*.dwl2" "*.sv$" "*.log"))
(setq kk (strcat sl-path0 "\" "main.ini") k3 (slmsg "版本" "セ" "version"))
(vl-catch-all-apply '(lambda () (writsetup))) ;;自启动系统
(vl-catch-all-apply '(lambda () (slcsh0))) ;变量设置1
(vl-catch-all-apply '(lambda () (slcsh))) ;;变量设置2
(setq k1 (strcat sl-path0 "\" "Support" "\" k0) k2 (strcat sl-path0 "\") s (readkey kk k3))
(if (or (/= s str) (= s nil))
(progn
(slfilcopy "base.dcl" k1 k2)
(slfilcopy "acad.dcl" k1 k2)
(slfilcopy "acad.pat" k1 k2)
(slfilcopy "acadiso.pat" k1 k2)
(rwritekey kk k3 str)
)
)
(if (= kk1 (strcase "ansi_936")) ;;CAD是简体版
(progn
(setq path1 (strcat (slpath (car (str->lst (getenv "ACAD") ";"))) "\")) ;;;取第一个支持路径,后面要带\\
(slfilcopy "txt.shx" (strcat sl-path0 "\" "Fonts") path1)
)
)
(setq
k1 (slmsg "下拉MENU" "┰MENU" "downMENU")
k2 (slmsg "专业" "盡穨" "major")
k3 (slmsg "图标菜单" "瓜夹垫虫" "IconMenu")
)
(if (= (readkey kk k1) nil)
(rwritekey kk k1 (slmsg "展开" "甶秨" "open"))
)
(if (= (readkey kk k2) nil)
(rwritekey kk k2 (slmsg "建筑" "縱" "Architecture"))
)
(if (= (readkey kk k3) nil)
(rwritekey kk k3 (slmsg "开" "秨" "open"))
)
(vl-catch-all-apply '(lambda () (menu00))) ;;菜单系统
(setq k1 (readkey kk k3) k2 (slmsg "三领" "烩" "SLdesign") k3 (slmsg "扑捉" "汲" "Osnap"))
(cond
((= k1 nil)
(rwritekey kk k3 k2)
(osnapoff)
)
((= k1 (slmsg "永驻" "ッ緉" "AlwaysON"))
(osnapon)
)
((= k1 k2)
(osnapoff)
)
)
(setq k1 (readkey kk k2) k2 (slmsg "空白出面板" "フ狾" "Blank-panel") k3 (slmsg "开" "秨" "Open"))
(cond
(if (= k1 nil)
(rwritekey kk k2 K3)
(slmbon)
)
(if (= k1 k3)
(slmbon)
)
(if (= k1 (slmsg "关" "闽" "Close"))
(slmboff)
)
)
(vl-catch-all-apply '(lambda () (load (strcat sl-path0 "\" "Support" "\" "slsystem.VLX")))) ;三领程序集
(vl-catch-all-apply '(lambda () (yhstartcx))) ;;加载用户目录下程序
)
)
)
(sl0000)

;;简体、繁体、英文提示---(一级)----- 
;;msg1 简体字 nil  msg2 繁体字 nil msg3 英文 nil-- 
(defun slmsg (msg1 msg2 msg3 / msg) 
  (cond 
    ((= $Lgver 1) 
      (setq msg msg1) 
    ) 
    ((= $Lgver 2) ;繁体版 
      (setq msg msg2) 
    ) 
    ((= $Lgver 3) 
      (setq msg msg3) 
    ) 
  ) 
  msg ;;输出信息 
) 
;;!!!!!!!!!!!!!!!!0000级加载!!!!!!!!!!!!!!!!!! 
;;(vla-put-displayscrollbars (vla-get-display (vla-get-preferences *Acad*)) 0) ;_关闭滚动条,浩辰测试错误 
(if (null vlax-dump-object) (vl-load-com));;将 Visual LISP 扩展功能加载到 AutoLISP 
;;常量定义 
(setq *Acad* (vlax-get-acad-object) 
  *AcDocument* (vla-get-activedocument *Acad*) 
  *Model-Space* (vla-get-modelspace *AcDocument*) 
  *Paper-Space* (vla-get-PaperSpace *AcDocument*) 
  *BLKS* (vla-get-Blocks *AcDocument*) 
  *LAYS* (vla-get-Layers *AcDocument*) 
  *ACLYS*  (vla-get-activeLayer *AcDocument*) 
  *LTS*  (vla-get-Linetypes *AcDocument*) 
  *GRPS* (vla-get-groups *AcDocument*) 
  pi2     (* pi 0.5) 
  pi4     (* pi 0.25) 
  3pi4   (* 0.75 pi) 
  2pi     (+ pi pi) 
  3pi2   (+ 3pi4 3pi4)  ;; (* 1.5 pi) 
  5pi4   (+ pi pi4)  ;;(* 1.25 pi) 
  7pi4   (+ 3pi2 pi4) ;;(* 1.75 pi) 
) 
;;------- 
(defun sl0000 (/ kk kk1 k0 k1 k2 k3 s str path1) 
  ;;(xlr-autolayer)防止天正崩溃(舍弃自动图层) 
  (setq kk1 (getvar "SYSCODEPAGE")) ;显示所在地区的代码 
  (cond 
    ((= kk1 (strcase "ansi_936"))   ;;CAD是简体版 
      (setq $Lgver 1 $hz "hz" $xz "xz" k0 "bz" str "简体中文" 
        $okbt ":button {label="确定";key="accept";is_default=true;}" 
        $canbt ":button {label="取消"; key="cancel";is_cancel=true;}" 
      ) 
    ) 
    ((= kk1 (strcase "ansi_950")) ;繁体版 
      (setq $Lgver 2 $hz "fan" $xz "fank" k0 "ft" str "羉砰いゅ" 
        $okbt ":button {label="絋﹚";key="accept";is_default=true;}" 
        $canbt ":button {label=""; key="cancel";is_cancel=true;}" 
      ) 
    ) 
    ((and (/= kk1 (strcase "ansi_936")) (/= kk1 (strcase "ansi_950"))) ;;英文或其他版 
      (setq $Lgver 3 $hz "hz" $xz "xz" k0 "en" str "Englishversion" 
        $okbt ":button {label="Accept";key="accept";is_default=true;}" 
        $canbt ":button {label="Cancel"; key="cancel";is_cancel=true;}" 
      ) 
    ) 
  ) 
  (setq 
    $row ":cluster {horizontal_margin=none; vertical_margin=none; children_alignment=centered;" 
    $column ":cluster {layout=vertical;horizontal_margin=none;vertical_margin=none;" 
    $boxed_row ":cluster {boxed=true;children_alignment=centered;" 
    $boxed_column ":cluster {layout=vertical;boxed=true;" 
    $radio_row ":radio_cluster {horizontal_margin=none;vertical_margin=none;children_alignment=centered;" 
    $radio_column ":radio_cluster {layout=vertical;horizontal_margin=none;vertical_margin=none;" 
    $boxed_radio_row ":radio_cluster {boxed=true;children_alignment=centered;" 
    $boxed_radio_column ":radio_cluster {layout=vertical;boxed=true;" 
  ) 
  (if (setq sl-path0 (sl-lujing)) 
    (progn 
      (sl:del-path-temp (strcat sl-path0 "\" "Support" "\") '("*.bak" "*.dwl" "*.dwl2" "*.sv$" "*.log")) 
      (sl:del-path-temp (strcat sl-path0 "\" "Fonts" "\") '("*.bak" "*.dwl" "*.dwl2" "*.sv$" "*.log")) 
      (sl:del-path-temp (strcat sl-path0 "\") '("*.bak" "*.dwl" "*.dwl2" "*.sv$" "*.log")) 
      (setq kk (strcat sl-path0 "\" "main.ini") k3 (slmsg "版本" "セ" "version")) 
      (vl-catch-all-apply '(lambda () (writsetup))) ;;自启动系统 
      (vl-catch-all-apply '(lambda () (slcsh0))) ;变量设置1 
      (vl-catch-all-apply '(lambda () (slcsh)))  ;;变量设置2 
      (setq k1 (strcat sl-path0 "\" "Support" "\" k0) k2 (strcat sl-path0 "\") s (readkey kk k3)) 
      (if (or (/= s str) (= s nil)) 
        (progn 
          (slfilcopy "base.dcl" k1 k2) 
          (slfilcopy "acad.dcl" k1 k2) 
          (slfilcopy "acad.pat" k1 k2) 
          (slfilcopy "acadiso.pat" k1 k2) 
          (rwritekey kk k3 str) 
        ) 
      ) 
      (if (= kk1 (strcase "ansi_936")) ;;CAD是简体版 
        (progn 
          (setq path1 (strcat (slpath (car (str->lst (getenv "ACAD") ";"))) "\")) ;;;取第一个支持路径,后面要带\\ 
          (slfilcopy "txt.shx" (strcat sl-path0 "\" "Fonts") path1) 
        ) 
      ) 
      (setq 
        k1 (slmsg "下拉MENU" "┰MENU" "downMENU") 
        k2 (slmsg "专业" "盡穨" "major") 
        k3 (slmsg "图标菜单" "瓜夹垫虫" "IconMenu") 
      ) 
      (if (= (readkey kk k1) nil) 
        (rwritekey kk k1 (slmsg "展开" "甶秨" "open")) 
      ) 
      (if (= (readkey kk k2) nil) 
        (rwritekey kk k2 (slmsg "建筑" "縱" "Architecture")) 
      ) 
      (if (= (readkey kk k3) nil) 
        (rwritekey kk k3 (slmsg "开" "秨" "open")) 
      ) 
      (vl-catch-all-apply '(lambda () (menu00))) ;;菜单系统   
      (setq k1 (readkey kk k3) k2 (slmsg "三领" "烩" "SLdesign") k3 (slmsg "扑捉" "汲" "Osnap")) 
      (cond 
        ((= k1 nil) 
          (rwritekey kk k3 k2) 
          (osnapoff) 
        ) 
        ((= k1 (slmsg "永驻" "ッ緉" "AlwaysON")) 
          (osnapon) 
        ) 
        ((= k1 k2) 
          (osnapoff) 
        ) 
      ) 
      (setq k1 (readkey kk k2) k2 (slmsg "空白出面板" "フ狾" "Blank-panel") k3 (slmsg "开" "秨" "Open")) 
      (cond 
        (if (= k1 nil) 
          (rwritekey kk k2 K3) 
          (slmbon) 
        ) 
        (if (= k1 k3) 
          (slmbon) 
        ) 
        (if (= k1 (slmsg "关" "闽" "Close")) 
          (slmboff) 
        ) 
      ) 
      (vl-catch-all-apply '(lambda () (load (strcat sl-path0 "\" "Support" "\" "slsystem.VLX")))) ;三领程序集 
      (vl-catch-all-apply '(lambda () (yhstartcx))) ;;加载用户目录下程序 
    ) 
  ) 
) 
(sl0000)

总启动部分

xyp1964 · 发表于昨天 21:46

尘缘一生发表于 2025-5-5 16:54
哪部分不是乱码，是港台地区的BIG5码，程序在港台地区CAD安装，程序会自动判定。
总启动部分

(setq k1 (readkey kk k2) k2 (slmsg "空白出面板" "フ狾" "Blank-panel") k3 (slmsg "开" "秨" "Open"))

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

[经验] SLdesign V3.0 线筋钩饰

本帖子中包含更多资源

点评

浏览过的版块