求两个cad lsp。1.cad中几个数字相乘。2.cad中几个数字做除法。并且都能控制小数点后的位数

 我来答
朱06CAD
2015-04-12 · 知道合伙人软件行家
朱06CAD
知道合伙人软件行家
采纳数:4172 获赞数:18069
高中,熟悉AutoCAD。会autolisp及VBA程序。

向TA提问 私信TA
展开全部
(defun C:CY1 ( / #os1 #os2 #os3 @k)
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (setvar "dimzin" 0)
 (vl-load-com) ;;加载vlax扩展函数
 (setq #os1 (getvar "osmode"))
 (setq #os2 (getvar "Clayer")
       #os3 (getvar "textstyle"); 取得当前字体样式
 )
 (initget "X S")
 (setq @k (getkword (strcat "\n请选择方式[数值相乘(X)/数值除以(S)]:<" "X" ">")))
 (if (= @k nil) (setq @k "X") )
 (setq @k (strcase @k))
 (setvar "osmode" 0)
 (if (= @k "X") (CY2) )
 (if (= @k "S") (CY4) )
 (setvar "osmode" #os1)
 (setvar "Clayer" #os2)
 (setvar "textstyle" #os3)
 (prin1)
)
(defun CY2 ( / #k1 #k2 &k1 &kw1 sz1 sz2)
 (princ "\n请选择要相乘的数值")
 (setq &kw1 (ssget (list (cons 0 "TEXT,MTEXT") (cons 1 "~*[~-.0-9]*" ))))
 (if (/= &kw1 nil)
  (progn
   (setq &k1 (ssname &kw1 0))
   (setq #k2 (entget &k1) SZ2 nil)
   (while &k1
    (setq &kw1 (ssdel &k1 &kw1)
          #k1 (entget &k1)
          SZ1 (atof (cdr (assoc 1 #k1)))
    )
    (if (and (/= SZ1 nil) (/= SZ2 nil)) (setq SZ2 (* SZ1 SZ2)) )
    (if (and (/= SZ1 nil) (= SZ2 nil)) (setq SZ2 SZ1) )
    (setq &k1 (ssname &kw1 0))
   )
   (if (/= SZ2 nil) (CY3 SZ2 #k2) )
  )
 )
)
;;
(defun CY3 (SZ2 #k2 / %k %k1 gd1 gr i kd n p1 p2 pt ss sz1)
 (setq SZ2 (cons 1 (rtos SZ2 2 3));数值为小数点后3位,要多少位自己修改
       SZ1 (assoc 1 #k2)
       #k2 (subst SZ2 SZ1 #k2)
       GD1 (cdr (assoc 40 #k2))
       kd (* 0.5 (caadr (textbox #k2)))
       ss '()
       ss (cons (cons 51 0) ss)
       %k '(8 7 10 41 40 1 0)
       i 0
 )
 (repeat (length %k)
  (setq %k1 (assoc (nth i %k) #k2)
        ss (cons %k1 ss)
        i (1+ i)
  )
 )
 (setq %k t i nil p2 (assoc 10 ss))
 (while %k
  (setq  gr (grread t 4 0);;取得鼠标操作及坐标
         n (car gr)
         pt (cadr gr)
  )
  (if (= n 5);;没有操作
   (progn
    (setq pt (polar pt pi kd) pt (polar pt (* 1.5 pi) (* GD1 0.5)));;文字坐标修改使鼠标坐标位于文字中点
    (if (/= i nil) (entdel i) );;如果有文字就删除
    (setq p1 (cons 10 pt) ss (subst p1 p2 ss) p2 p1)
    (entmake ss);;重新生成文字
    (setq i (entlast));;得到文字图元名
   )
  )
  (if (= n 3) (setq %k nil) );;3表示左键;结束循环
  (if (or (= n 2) (= n 25));;2表示空格;25表示右键;结束循环并删除文字
   (progn
    (setq %k nil)
    (entdel i)
   )
  )
 )
)
;
(defun CY4 ( / #k1 #k2 &k1 &kw1 sz1 sz2)
 (setq SZ2 (CY5) )
 (if (/= SZ2 nil)
  (progn
   (princ "\n请选择除数")
   (setq &kw1 (ssget (list (cons 0 "TEXT,MTEXT") (cons 1 "~*[~-.0-9]*" ))))
   (if (/= &kw1 nil)
    (progn
     (setq &k1 (ssname &kw1 0) #k2 (entget &k1))
     (while &k1
      (setq &kw1 (ssdel &k1 &kw1)
            #k1 (entget &k1)
            SZ1 (atof (cdr (assoc 1 #k1)))
      )
      (if (and (/= SZ1 0) (/= SZ1 nil)) (setq SZ2 (/ SZ2 SZ1)) )
      (setq &k1 (ssname &kw1 0))
     )
     (CY3 SZ2 #k2)
    )
   )
  )
 )
)
;
(defun CY5 ( / #k1 %k1 %k2 ent1)
 (setq ent1 (entsel "\n请选择被除数") %k2 nil)
 (if (/= ent1 nil)
  (progn
   (setq #k1 (entget (car ent1))
         %k1 (cdr (assoc 0 #k1))
   )
   (if (or (= %k1 "TEXT") (= %k1 "MTEXT")) (setq %k2 (atof (cdr (assoc 1 #k1)))) )
  )
 )
 %k2
);复制到记事本以【.lsp】为后缀命名,autoLISP加载,命令为【CY1】,小数点后面数字自己修改即可,有说明。得到的数值随鼠标移动,点击一下就可以结束动作。
来自:求助得到的回答
丘上秋树
2015-04-11 · TA获得超过130个赞
知道答主
回答量:194
采纳率:100%
帮助的人:97.5万
展开全部
不能复制粘贴么!
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 1条折叠回答
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式