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

664571221

(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)  
)

尘缘一生

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

1. (defun c:rec ()
   
2.   (defun udist (bit kwd msg def bpt / inp)
   
3.     (if def
   
4.     (setq msg(strcat"\n"msg"<"(rtos def)">: ")
   
5.           bit(* 2(fix(/ bit 2)))
   
6.     )
   
7.     (setq msg(strcat"\n"msg": "))
   
8.   )
   
9.   (initget bit kwd)
   
10.   (setq inp(if bpt(getdist msg bpt)(getdist msg)))
    
11.   (if inp inp def)
    
12. )
    
13.   (setq p1 (getpoint "\n指定基点: "))
    
14.   (if (setq p9 (getcorner p1 "\n对角点:"))
    
15.     (command "rectang" "non"p1 "non"p9)
    
16.     (progn
    
17.       (setq ww (Udist 3 "" "宽度<输入或鼠标直接量取>" ww nil))
    
18.       (setq hh (Udist 3 "" "高度<输入或鼠标直接量取>" hh nil))
    
19.       (setq p9 (mapcar '+ p1 (list ww hh)))
    
20.       (command "rectang" "non"p1 "non"p9)
    
21.     )
    
22.   )
    
23.   (princ)
    
24. )

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

xiao1984

(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)
)

飞雪神光

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

czb203

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

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

尘缘一生

• ;;字符串转表 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)
• )
  

煮茗

论坛搜索出来的。来自黄总。

2. ;;自贡黄明儒--提取数字
   
3. (defun getNumberS (str / ASC N STR1 STRN)
   
4.   (setq n 1)
   
5.   (setq str1 "")
   
6.   (repeat (strlen str)
   
7.     (setq strn (substr str n 1))
   
8.     (setq Asc (ascii strn))
   
9.     (if        (or (and (> Asc 47) (< Asc 58)) (= Asc 46))
   
10.       (setq str1 (strcat str1 strn))
    
11.       (setq str1 (strcat str1 " "))
    
12.     )
    
13.     (setq n (1+ n))
    
14.   )
    
15.   (strinSplitS str1)
    
16. )
    
17. (defun strinSplitS (str / lst)
    
18.   (setq str (STRCAT "(" str ")"))
    
19.   (setq lst (read str))
    
20.   (setq lst (mapcar 'VL-PRINC-TO-STRING lst))
    
21. )

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

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

664571221

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

谢谢兄弟...

664571221

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

谢谢派大...