各位大神看下，这个画矩形的函数缺少了一个getnumbers，能否帮忙补全一下

664571221 发表于 2024-12-17 17:59:56

(defun C:rec(/ x y pta ptb)
(setq pta (getpoint "\n指定基点"))
(initget "A D R")
(if (setq ptb (getcorner pta "\n>>>指定下一点:【空格：尺寸输入】[面积(S)/尺寸(D)/旋转(R)]:"))
(command "rectang" pta ptb)
(progn
   (setq lst (getNumberS(setq ss (getstring "\n 宽 & 高 : <30*30>"))))
(setq x (car lst))
(setq y (cadr lst))
   (command "rectang" pta "d" x y pause)
)
)
(princ)
)

尘缘一生 发表于 2024-12-17 19:44:28

本帖最后由尘缘一生于 2024-12-17 19:46 编辑

SLdesign 集成有，但是我加了个K，你变通下试试

[*]

[*];;提取不等于0数字字符串----(一级)-----
[*];k t 均取正值nil 带-号取负值
[*];(getnumbers "-mao毛.-%%p00000泽.%%153东-300x8.0%%130" nil)--->("-300" "8.0")
[*](defun getnumbers (str k / asc str0 str1 defined asclis lis0 lst lis num)
[*](setq defined
[*] (list
[*]    "%%130" "%%131" "%%132" "%%133" "%%134" ;1~4级钢筋符号+特殊钢筋
[*]    "%%135" "%%136" "%%137" "%%138"
[*]    "%%150" "%%151" "%%152" "%%153" "%%154" "%%155" "%%156" "%%157" "%%158" "%%159" ;罗马数字
[*]    "%%177" "%%p" "%%P" ;正负号
[*]    "%%c" "%%C" "%%D" "%%d" "%%%" ;直径符号+度数符号+%
[*]    "%%140" "%%141" "%%142" "%%143"
[*]    "%%200" "%%201" "%%202" "%%203" "%%204" "%%205" ;圆圈数字
[*]    "\U+0082" ;旧字库一级筋
[*] )
[*])
[*](while defined
[*] (setq str (t-string-subst "" (car defined) str))
[*] (setq defined (cdr defined))
[*])
[*](setq asclis (vl-string->list str) str1 "")
[*](while (setq asc (car asclis))
[*] (if (or (and (> asc 47) (< asc 58)) (= asc 45) (= asc 46)) ;1-9 - .
[*]    (setq str1 (strcat str1 (chr asc)))
[*]    (setq str1 (strcat str1 " "))
[*] )
[*] (setq asclis (cdr asclis))
[*])
[*](setq lst (str->lst str1 " "))
[*](while lst
[*] (setq str (slreverstr (car lst)))
[*] (while (= (substr str 1 1) ".");去除最后的 "."
[*]    (setq str (substr str 2 (1- (strlen str))))
[*] )
[*] (setq str (slreverstr str))
[*] (if (and (/= str "") (/= str ".") (/= str "-")) ;排除..
[*]    (if (/= (substr str 1 1) "-") ;中间带有"-"号的
[*]    (progn
[*]       (setq lis0 (str->lst str "-"))
[*]       (while (setq str (car lis0))
[*]          (setq num (distof str))
[*]          (if (and num (> (abs num) 0))
[*]          (setq lis (cons str lis))
[*]          )
[*]          (setq lis0 (cdr lis0))
[*]       )
[*]    )
[*]    (progn
[*]       (setq num (distof str))
[*]       (if (and num (> (abs num) 0))
[*]          (setq lis (cons str lis))
[*]       )
[*]    )
[*]    )
[*] )
[*] (setq lst (cdr lst))
[*])
[*](if k (setq lis (mapcar '(lambda (x) (t-string-subst "" "-" x)) lis))) ;全取正时，去"-"号
[*](reverse lis)
[*])

[*];;倒置字符串--(一级)-----------
[*](defun slreverstr (str / a b)
[*](setq b "")
[*](while (> str "")
[*] (if (< (ascii (substr str 1 1)) 129)
[*]    (setq b (strcat (substr str 1 1) b) str (substr str 2))
[*]    (setq b (strcat (substr str 1 2) b) str (substr str 3))
[*] )
[*])
[*]b
[*])

[*];;字符串以旧换新----(一级)----
[*];;(t-string-subst "毛" "a" "abc")->"毛bc"
[*](defun t-string-subst (new old str / n)
[*](setq n (- (strlen new)))
[*](while (setq n (vl-string-search old str (min (+ n (strlen new)) (strlen str))))
[*] (setq str (vl-string-subst new old str n))
[*])
[*]str
[*])

xyp1964 发表于 2024-12-17 20:27:28

(defun c:rec ()
(defun udist (bit kwd msg def bpt / inp)
(if def
(setq msg(strcat"\n"msg"<"(rtos def)">: ")
   bit(* 2(fix(/ bit 2)))
)
(setq msg(strcat"\n"msg": "))
)
(initget bit kwd)
(setq inp(if bpt(getdist msg bpt)(getdist msg)))
(if inp inp def)
)
(setq p1 (getpoint "\n指定基点: "))
(if (setq p9 (getcorner p1 "\n对角点:"))
(command "rectang" "non"p1 "non"p9)
(progn
   (setq ww (Udist 3 "" "宽度<输入或鼠标直接量取>" ww nil))
   (setq hh (Udist 3 "" "高度<输入或鼠标直接量取>" hh nil))
   (setq p9 (mapcar '+ p1 (list ww hh)))
   (command "rectang" "non"p1 "non"p9)
)
)
(princ)
)

xiao1984 发表于 2024-12-17 23:01:16

(defun C:rec (/ x y pta ptb)
(setq pta (getpoint "\n指定基点: "))
(initget "A D R")
(if (setq ptb (getcorner pta "\n>>>指定下一点:【空格：尺寸输入】[面积(A)/尺寸(D)/旋转(R)]: "))
(command "rectang" pta ptb)
(progn
   (setq lst (getNumberS (setq ss (getstring "\n 宽 & 高 : <30*30> "))))
   (if (and lst (= (length lst) 2))
   (progn
      (setq x (car lst))
      (setq y (cadr lst))
      (command "rectang" pta "D" x y)
   )
   (princ "\n输入错误，请输入两个数值。")
   )
)
)
(princ)
)

飞雪神光 发表于 2024-12-17 18:12:03

得到输入的数值呗比如通过 * 分割字符串

czb203 发表于 2024-12-17 18:47:39

飞雪神光发表于 2024-12-17 18:12
得到输入的数值呗比如通过 * 分割字符串

神光大侠一语点破，有道理~

尘缘一生 发表于 2024-12-17 19:52:53

[*];;字符串转表 str 字符串 sign 分割符号----(一级)---------
[*];;(str->lst "1 2 3 4" " ")->("1" "2" "3" "4")
[*];;(str->lst "毛泽东;88;xy;z" ";")->("毛泽东" "88" "xy" "z")
[*];;(str->lst "毛泽东;88;xy;z" "泽东")->("毛" ";88;xy;z")
[*](defun str->lst (str sign / lst n1 n2 str_1 m2)
[*](setq lst '())
[*](setq n1 (strlen str))
[*](setq n2 (strlen sign))
[*](while (setq m2 (vl-string-search sign str))
[*] (setq str_1 (substr str 1 m2))
[*] (setq str (substr str (+ 1 m2 n2)))
[*] (if (/= str_1 "")
[*] (setq lst (cons str_1 lst))
[*] )
[*])
[*](if (/= str "")
[*] (setq lst (cons str lst))
[*])
[*](reverse lst)
[*])

煮茗发表于 2024-12-17 20:14:24

论坛搜索出来的。来自黄总。
;;自贡黄明儒--提取数字
(defun getNumberS (str / ASC N STR1 STRN)
(setq n 1)
(setq str1 "")
(repeat (strlen str)
(setq strn (substr str n 1))
(setq Asc (ascii strn))
(if    (or (and (> Asc 47) (< Asc 58)) (= Asc 46))
   (setq str1 (strcat str1 strn))
   (setq str1 (strcat str1 " "))
)
(setq n (1+ n))
)
(strinSplitS str1)
)
(defun strinSplitS (str / lst)
(setq str (STRCAT "(" str ")"))
(setq lst (read str))
(setq lst (mapcar 'VL-PRINC-TO-STRING lst))
)

(initget "A D R")
(if (setq ptb (getcorner pta "\n>>>指定下一点:【空格：尺寸输入】[面积(S)/尺寸(D)/旋转(R)]:"))
你这两句，A D R和S D R不对应。运行会有小问题。

664571221 发表于 2024-12-18 09:09:02

xiao1984 发表于 2024-12-17 23:01
(defun C:rec (/ x y pta ptb)
(setq pta (getpoint "\n指定基点: "))
(initget "A D R")

谢谢兄弟...

664571221 发表于 2024-12-18 09:10:46

xyp1964 发表于 2024-12-17 20:27

谢谢派大...

页: [1] 2

明经CAD社区's Archiver

各位大神看下，这个画矩形的函数缺少了一个getnumbers，能否帮忙补全一下