设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 哪位高手可以帮忙修改一下呢 ，增加指定精度的功能
返回列表 发新帖
查看: 1159|回复: 6

[提问] 哪位高手可以帮忙修改一下呢 ，增加指定精度的功能

[复制链接]
3wlds
发表于 2014-12-26 14:03:02 | 显示全部楼层 |阅读模式
本帖最后由 ZZXXQQ 于 2014-12-27 10:32 编辑

以前在网上下载了一个运算器的代码很好用，就不是不能指定小数精度。哪位高手可以帮忙修改一下呢 ，增加指定精度的功能、代码如下呢
  2. ;;;运算器(缺省输入)
  3. ;;;       作者： langjs
  4. ;;;________________________________________________________________
  5. (defun c:js ( / uu txt3 ent)  
  6. (if (/= fuh "+"  fuh "-"  fuh "*" fuh "/"  )(setq fuh "*"  ))
  7. (if (/= mos "a" mos "b")(setq  mos "a" ))
  8. (setq txt1  (getstring (strcat "\n请输入运算符号[加(+)/减(-)/乘(*)/除(/)] <"  fuh ">:"   ) ))
  9. (if (/= txt1 "+"  txt1 "-"  txt1 "*" txt1 "/" txt1 "" )(exit ))
  10. (setq zz  (getstring (strcat "\n请输入模式[单步(A)/连续(B)] <" (strcase mos) ">:"   ) ))
  11. (setq zz (strcase zz T))
  12. (if (/= zz "a"  zz "b" zz "" )(exit ))
  13. ( if (= txt1 "") (setq  txt1 fuh ) (setq   fuh txt1)  )
  14. ( if (= zz "") (setq  zz mos ) (setq  mos zz )  )

  16. (setq uu (strcat txt1 zz))
  17. (cond
  18. ((= uu "+a") (h01 ))
  19. ((= uu "+b") (h02 ))
  20. ((= uu "*a") (h03 ))
  21. ((= uu "*b") (h04 ))
  22. ((= uu "-a") (h05 ))
  23. ((= uu "-b") (h06 ))
  24. ((= uu "/a") (h07 ))
  25. ((= uu "/b") (h08 ))

  27. )        
  28. (princ )
  29. )

  31. (defun h01 ( )
  32. (princ "\n 单步加法运算:"  )
  33. (princ "\n")
  34. (setq ent (car (entsel "\n选择第一个加数：")))
  35.         (setq txt2 (entget ent))
  36.         (setq txt2 (atof (cdr (assoc 1 txt2)) ))
  37.         (princ (rtos txt2)  )
  38. (setq ent (car (entsel "\n选择第二个加数：")))
  39.         (setq txt3 (entget ent))
  40.         (setq txt3 (atof (cdr (assoc 1 txt3)) ))
  41.         (princ (rtos txt3)  )
  42.         (setq sum(+ txt2 txt3 ))
  43.         (princ (strcat "\n两数的和为：" (rtos sum)  ))
  44.         (setq ent (car (entsel "\n选择和数的位置：")))
  45.        (princ "完成"  )
  46.         (setq ent (entget ent))
  47.          (setq ent  (subst (cons 1 (rtos sum  2 2) ) (assoc 1 ent) ent) )
  48.       (entmod ent)
  49. (princ)
  50. )

  52. (defun h02 (/ LEN MODELTXT SSTEXT TXTENT)
  53.   (princ "\n 连续加法运算:"  )
  54.   (prompt "\n请选择加数:")
  55.   (setq sstext (ssget '((0 . "text,MTEXT"))))
  56.   (if sstext
  57.     (progn
  58.       (setq sum  0.0 )
  59.       (setq mm  0 )
  60.      (princ "选择的加数：")
  61.       (repeat
  62.         (setq len (sslength sstext)   )
  63.         (setq txtent (ssname sstext (setq len (1- len))))
  64.      
  65.         (setq modeltxt (cdr (assoc 1 (entget txtent))))

  67.        (setq sum (+ sum  (atof modeltxt) ) )
  68.         (setq mm (+ mm 1)   )  
  69.        (princ  (strcat "\n   第" (itoa mm)  "加数:"  ))
  70.        (princ modeltxt)   
  71.       )
  72.     )
  73.   )
  74.        (princ "\n累计的和为:"  )
  75.       (princ (rtos sum ))
  76.        (setq ent (car (entsel "\n选择和数的位置：")))
  77.         (princ "\n完成"  )
  78.          (setq ent (entget ent))
  79.          (setq ent  (subst (cons 1 (rtos sum  2 2) ) (assoc 1 ent) ent) )
  80.       (entmod ent)
  81.   (princ)
  82. )


  85. (defun h03 ( )
  86. (princ "\n 单步乘法运算:"  )
  87. (princ "\n")
  88. (setq ent (car (entsel "\n选择第一个因子：")))
  89.         (setq txt2 (entget ent))
  90.         (setq txt2 (atof (cdr (assoc 1 txt2)) ))
  91.         (princ (rtos txt2)  )
  92. (setq ent (car (entsel "\n选择第二个因子：")))
  93.         (setq txt3 (entget ent))
  94.         (setq txt3 (atof (cdr (assoc 1 txt3)) ))
  95.         (princ (rtos txt3)  )
  96.         (setq sum(* txt2 txt3 ))
  97.         (princ (strcat "\n两数的积为：" (rtos sum)  ))
  98.         (setq ent (car (entsel "\n选择积的位置：")))
  99.        (princ "完成"  )
  100.         (setq ent (entget ent))
  101.          (setq ent  (subst (cons 1 (rtos sum  2 2) ) (assoc 1 ent) ent) )
  102.       (entmod ent)
  103. (princ)
  104. )

  106. (defun h04 (/ LEN MODELTXT SSTEXT TXTENT)
  107.   (princ "\n 连续乘法运算:"  )
  108.   (prompt "\n请选择因子:")
  109.   (setq sstext (ssget '((0 . "text,MTEXT"))))
  110.   (if sstext
  111.     (progn
  112.       (setq sum  1 )
  113.       (setq mm  0 )
  114.      (princ "选择的因子：")
  115.       (repeat
  116.         (setq len (sslength sstext)   )
  117.         (setq txtent (ssname sstext (setq len (1- len))))
  118.      
  119.         (setq modeltxt (cdr (assoc 1 (entget txtent))))

  121.        (setq sum (* sum  (atof modeltxt) ) )
  122.         (setq mm (+ mm 1)   )  
  123.        (princ  (strcat "\n  第" (itoa mm)  "因子:"  ))
  124.        (princ modeltxt)   
  125.       )
  126.     )
  127.   )
  128.        (princ "\n累计的积为:"  )
  129.       (princ (rtos sum ))
  130.        (setq ent (car (entsel "\n选择积的位置：")))
  131.         (princ "\n完成"  )
  132.          (setq ent (entget ent))
  133.          (setq ent  (subst (cons 1 (rtos sum  2 2) ) (assoc 1 ent) ent) )
  134.       (entmod ent)
  135.   (princ)
  136. )

  138. (defun h05 ( )
  139. (princ "\n 单步减法运算:"  )
  140. (princ "\n")
  141. (setq ent (car (entsel "\n选择被减数：")))
  142.         (setq txt2 (entget ent))
  143.         (setq txt2 (atof (cdr (assoc 1 txt2)) ))
  144.         (princ (rtos txt2)  )
  145. (setq ent (car (entsel "\n选择减数：")))
  146.         (setq txt3 (entget ent))
  147.         (setq txt3 (atof (cdr (assoc 1 txt3)) ))
  148.         (princ (rtos txt3)  )
  149.         (setq sum(- txt2 txt3 ))
  150.         (princ (strcat "\n两数的差为：" (rtos sum)  ))
  151.         (setq ent (car (entsel "\n选择差数的位置：")))
  152.        (princ "完成"  )
  153.         (setq ent (entget ent))
  154.          (setq ent  (subst (cons 1 (rtos sum  2 2) ) (assoc 1 ent) ent) )
  155.       (entmod ent)
  156. (princ)
  157. )

  159. (defun h06 (/ LEN MODELTXT SSTEXT TXTENT txt2 )
  160.   (princ "\n 连续减法运算:"  )
  161. (setq ent (car (entsel "\n选择被减数：")))
  162.         (setq txt2 (entget ent))
  163.         (setq txt2 (atof (cdr (assoc 1 txt2)) ))
  164.         (princ (rtos txt2)  )
  165.   (setq sstext (ssget '((0 . "text,MTEXT"))))
  166.   (if sstext
  167.     (progn
  168.       (setq sum  0.0 )
  169.       (setq mm  0 )
  170.      (princ "选择减数：")
  171.       (repeat
  172.         (setq len (sslength sstext)   )
  173.         (setq txtent (ssname sstext (setq len (1- len))))
  174.      
  175.         (setq modeltxt (cdr (assoc 1 (entget txtent))))

  177.        (setq sum (- sum  (atof modeltxt) ) )
  178.         (setq mm (+ mm 1)   )  
  179.        (princ  (strcat "\n   第" (itoa  mm )  "减数:"  ))
  180.        (princ modeltxt)   
  181.       )
  182.     )
  183.   )
  184.        (princ "\n累计的差为:"  )

  186. (setq sum (+ txt2 sum ) )
  187.       (princ (rtos  sum  ))
  188.        (setq ent (car (entsel "\n选择差的位置：")))
  189.         (princ "\n完成"  )
  190.          (setq ent (entget ent))
  191.          (setq ent  (subst (cons 1 (rtos sum  2 2) ) (assoc 1 ent) ent) )
  192.       (entmod ent)
  193.   (princ)
  194. )


  197. (defun h07 ( )
  198. (princ "\n 单步除法运算:"  )
  199. (princ "\n")
  200. (setq ent (car (entsel "\n选择被除数：")))
  201.         (setq txt2 (entget ent))
  202.         (setq txt2 (atof (cdr (assoc 1 txt2)) ))
  203.         (princ (rtos txt2)  )
  204. (setq ent (car (entsel "\n选择除数：")))
  205.         (setq txt3 (entget ent))
  206.         (setq txt3 (atof (cdr (assoc 1 txt3)) ))
  207.         (princ (rtos txt3)  )
  208.         (setq sum(/ txt2 txt3 ))
  209.         (princ (strcat "\n两数的商为：" (rtos sum)  ))
  210.         (setq ent (car (entsel "\n选择商数的位置：")))
  211.        (princ "完成"  )
  212.         (setq ent (entget ent))
  213.          (setq ent  (subst (cons 1 (rtos sum  2 2) ) (assoc 1 ent) ent) )
  214.       (entmod ent)
  215. (princ)
  216. )

  218. (defun h08(/ LEN MODELTXT SSTEXT TXTENT txt2 )
  219.   (princ "\n 连续除法运算:"  )
  220. (setq ent (car (entsel "\n选择被除数：")))
  221.         (setq txt2 (entget ent))
  222.         (setq txt2 (atof (cdr (assoc 1 txt2)) ))
  223.         (princ (rtos txt2)  )
  224.   (setq sstext (ssget '((0 . "text,MTEXT"))))
  225. (if sstext
  226.     (progn
  227.       (setq sum  1 )
  228.       (setq mm  0 )
  229.      (princ "选择的除数：")
  230.       (repeat
  231.         (setq len (sslength sstext)   )
  232.         (setq txtent (ssname sstext (setq len (1- len))))
  233.      
  234.         (setq modeltxt (cdr (assoc 1 (entget txtent))))

  236.        (setq sum (* sum  (atof modeltxt) ) )
  237.         (setq mm (+ mm 1)   )  
  238.        (princ  (strcat "\n  第" (itoa mm)  "除数:"  ))
  239.        (princ modeltxt)  
  240.       )
  241.     )
  242.   )
  243.        (princ "\n累计的商为:"  )

  245. (setq sum (/ txt2 sum ) )
  246.       (princ (rtos  sum  ))
  247.        (setq ent (car (entsel "\n选择商的位置：")))
  248.         (princ "\n完成"  )
  249.          (setq ent (entget ent))
  250.          (setq ent  (subst (cons 1 (rtos sum  2 2) ) (assoc 1 ent) ent) )
  251.       (entmod ent)
  252.   (princ)
  253. )






  260. ;;;同变刷，将文本数字或者尺寸数值内容刷成源数值加上或减去同一个数值(缺省输入)
  261. ;;;________________________________________________________________
  262. (defun c:tb ( / uu txt3 ent)  
  263. (if (= chanshu001 nil )(setq chanshu001 -500.0  ))
  264. (if (>= chanshu001 0.0 )(setq uu "+") (setq uu "")  )
  265. (setq txt3 (atof (getstring (strcat "\n 同变刷:输入变化的值 <" uu (rtos chanshu001) ">:"   ) )))
  266. (cond
  267. ((null txt3) (setq chanshu001 chanshu001))
  268. ((= txt3 0.0 ) (setq chanshu001 chanshu001))
  269. (t (setq chanshu001 txt3)))        

  271.     (while t
  272.         (setq ent (car (entsel "\n选择目标文字或尺寸：")))
  273.         (setq ent (entget ent))
  274.        (cond
  275.        ((= (cdr (assoc 1 ent)) "<>{}{}")    (setq txt2  (cdr (assoc 42 ent))) )
  276.        ((= (cdr (assoc 1 ent)) "" )    (setq txt2  (cdr (assoc 42 ent)))    )
  277.        (t     (setq txt2  (atof (cdr (assoc 1 ent)))))
  278.        )     

  280.         (if (>= chanshu001 0.0 )
  281.         (setq ent  (subst (cons 1 (rtos  (+ txt2  (abs chanshu001)) 2 1) ) (assoc 1 ent) ent) )
  282.         )  
  283.         (if (< chanshu001 0.0 )
  284.         (setq ent  (subst (cons 1 (rtos  (- txt2  (abs chanshu001)) 2 1 ) ) (assoc 1 ent) ent) )
  285.         )  
  286.         (entmod ent)
  287.         )
  288. )




  293. ;;;__________________________________________
  294. ;;; 相同刷，将文字或者尺寸内容改成源内容
  295. ;;;__________________________________________
  296. (defun c:xt (/ LEN MODELTXT SSTEXT TXTENT)
  297.   (prompt "\n 相同刷:请选择样本文字:")
  298.   (setq sstext (ssget '((0 . "text,MTEXT"))))
  299.   (if sstext
  300.     (progn
  301.       (setq modeltxt (cdr (assoc 1 (entget (ssname sstext 0)))))
  302.       (repeat (setq len (sslength sstext))
  303. (setq txtent (ssname sstext (setq len (1- len))))
  304. (entmod
  305.    (subst (cons 1 modeltxt)
  306.    (assoc 1 (entget txtent))
  307.    (entget (ssname sstext len))
  308.    )
  309. )
  310. (entupd txtent)
  311.       )
  312.     )
  313.   )

  315.   (princ)
  316. )


  319. ;;; 加一刷 将文本末尾的数字递增加1
  320. ;;;__________________________________________

  322. (defun c:jy( )
  323. (setq ent (car (entsel "\n 加一刷:选起始文字:")))
  324.         (setq txt1 (entget ent))
  325.         (setq txt1 (cdr (assoc 1 txt1)))


  328. (setq  aa (atoi txt1))

  330. (if (and (> aa 0 ) (= (itoa aa) txt1  )  )  (tj2 )  (tj1 )   )
  331. (princ)
  332. )

  334. (defun tj1( / mm zz  pp txt2 ent kk txt3)
  335. (setq  mm (strlen txt1))
  336. (setq zz mm )
  337. (while  (or (> (atoi (substr txt1 zz )) 0)  (=  (substr txt1 zz zz ) "0" ))  
  338. (setq zz (- zz 1))
  339. )
  340. (setq pp  (substr txt1 (+ zz 1) ))
  341. (setq txt2  (substr txt1 1  zz  ))
  342. (setq kk (atoi pp) )
  343. (while t
  344.   (setq ent (car (entsel "\n选择目标文字：")))
  345. (setq kk (+ kk 1 ))
  346. (setq  txt3 (strcat txt2 (itoa kk)))
  347.       (setq ent (entget ent))
  348.        (setq ent  (subst (cons 1 txt3) (assoc 1 ent) ent)    )
  349.       (entmod ent)
  350. )
  351. (princ)
  352. )


  355. (defun tj2 ( /  txt2 num txt3)
  356. (setq num 0 )
  357. (setq txt2 (atoi txt1))
  358. (while t
  359. (setq num (+ num 1  ))
  360. (setq txt3 ( + txt2 num)  )
  361.         (setq ent (car (entsel "\n选择目标文字或尺寸:")))
  362.         (setq ent (entget ent))
  363.         (setq ent  (subst (cons 1 (itoa txt3) ) (assoc 1 ent) ent) )
  364.         (entmod ent)
  365.         )
  366. (princ)
  367. )



  371. ;;; 线宽刷
  372. ;;;__________________________________________


  375. (princ "\n**工具刷合集,自由软件,作者：国电南自 郎建山。**" )

  377. (defun sz_s()
  378.   (setq wd1 "\n当前匹配属性：" wd0 "不匹配属性：")
  379.   (if (= sz_color 1) (setq wd1 (strcat wd1 " 颜色")) (setq wd0 (strcat wd0 " 颜色")))
  380.   (if (= sz_layer 1) (setq wd1 (strcat wd1 " 图层")) (setq wd0 (strcat wd0 " 图层")))
  381.   (if (= sz_ltype 1) (setq wd1 (strcat wd1 " 线形")) (setq wd0 (strcat wd0 " 线形")))
  382.   (if (= sz_ltsca 1) (setq wd1 (strcat wd1 " 线形比例")) (setq wd0 (strcat wd0 " 线形比例")))
  383.   (if (= sz_asywh 1) (setq wd1 (strcat wd1 " 变宽线形")) (setq wd0 (strcat wd0 " 变宽线形")))
  384.   (if (= wd1 "\n当前匹配属性：") (setq wd1 "\n当前匹配属性：宽度")(setq wd1 (strcat wd1 "。")))
  385.   (if (= wd0 "不匹配属性：") (setq wd0 "") (setq wd0 (strcat wd0 "。")))
  386.   (princ (strcat "\n***" wd1 wd0))
  387.   (initget "1 2 3 4 5")
  388.   (setq setk(getkword "\n改变：颜色1/图层2/线形3/线形比例4/变宽线形5/<确认>："))
  389.   (cond
  390.     ((= setk "1") (if (= sz_color 1) (setq sz_color 0) (setq sz_color 1)) (sz_s))
  391.     ((= setk "2") (if (= sz_layer 1) (setq sz_layer 0) (setq sz_layer 1)) (sz_s))
  392.     ((= setk "3") (if (= sz_ltype 1) (setq sz_ltype 0) (setq sz_ltype 1)) (sz_s))
  393.     ((= setk "4") (if (= sz_ltsca 1) (setq sz_ltsca 0) (setq sz_ltsca 1)) (sz_s))
  394.     ((= setk "5") (if (= sz_asywh 1) (setq sz_asywh 0) (setq sz_asywh 1)) (sz_s))
  395.     (t nil)
  396.   )
  397. )

  399. (defun sz_b(num enum um / j b0 bj)
  400.   (if (and (assoc num ei) enum)
  401.     (setq ei (subst enum (assoc num ei) ei))
  402.     (if enum
  403.       (setq ei (reverse (cons enum (reverse ei))))
  404.       (if (assoc num ei)
  405.         (progn
  406.           (setq j -1
  407.                 b0 nil
  408.           )
  409.           (repeat (length ei)
  410.             (setq j (1+ j)
  411.                   bj(nth j ei)
  412.             )
  413.             (if (/= bj (assoc num ei))
  414.           (setq b0 (cons bj b0))
  415.           (if um (setq b0 (cons (cons num um) b0)))
  416.             )
  417.           )
  418.       (setq ei (reverse b0))
  419.         )
  420.       )
  421.     )
  422.   )
  423. )

  425. (defun sz_main()
  426.   (setq len (sslength ss1)
  427.     i   -1
  428.     ent0(entget (car ent1))
  429.     e62 (assoc 62 ent0)
  430.     e8  (assoc 8 ent0)
  431.     e6  (assoc 6 ent0)
  432.     e48 (assoc 48 ent0)
  433.     e43 (assoc 43 ent0)
  434.     e90 (cdr (assoc 90 ent0))
  435.   )
  436.   (if (>= e90 3)
  437.     (progn
  438.       (repeat 3 (setq ent0 (subst (cons 11 (cdr (assoc 10 ent0))) (assoc 10 ent0) ent0)))
  439.       (setq ent0 (reverse ent0)
  440.             ent0 (reverse (cons (car ent0) (cdr (member (assoc 11 ent0) ent0))))
  441.         ent0 (subst '(90 . 2) (assoc 90 ent0) ent0)
  442.       )
  443.       (repeat 2 (setq ent0 (subst (cons 10 (cdr (assoc 11 ent0))) (assoc 11 ent0) ent0)))
  444.     )
  445.   )
  446.   (repeat len
  447.     (setq i (1+ i)
  448.       eni (ssname ss1 i)
  449.       ei  (entget eni)
  450.     )
  451.     (cond
  452.       ((= (cdr (assoc 0 ei)) "LWPOLYLINE")
  453.        (sz_lwp)
  454.       )
  455.       ((= (cdr (assoc 0 ei)) "LINE")
  456.        (sz_line)
  457.       )
  458.       ((= (cdr (assoc 0 ei)) "ARC")
  459.        (sz_arc)
  460.       )
  461.       ((= (cdr (assoc 0 ei)) "CIRCLE")
  462.        (sz_circle)
  463.       )
  464.       (t nil)
  465.     )
  466.   )
  467. )

  469. (defun sz_lwp()
  470.   (if (= sz_color 1) (sz_b 62 e62 256))
  471.   (if (= sz_layer 1) (setq ei (subst e8 (assoc 8 ei) ei)))
  472.   (if (= sz_ltype 1) (sz_b 6 e6 "BYLAYER"))
  473.   (if (= sz_ltsca 1) (sz_b 48 e48 1.0))
  474.   (if (assoc 43 ei)
  475.     (setq ei (subst e43 (assoc 43 ei) ei))
  476.     (if (= sz_asywh 1)
  477.       (setq ei (reverse (cons e43 (reverse ei))))
  478.     )
  479.   )
  480.   (entmod ei)
  481.   (entupd eni)
  482. )

  484. (defun sz_line(/ ei62 ei8 ei6 ei48 ei10 ei11)
  485.   (setq ei62 (assoc 62 ei)
  486.         ei8  (assoc 8 ei)
  487.         ei6  (assoc 6 ei)
  488.         ei48 (assoc 48 ei)
  489.         ei10 (assoc 10 ei)
  490.         ei11 (assoc 11 ei)
  491.   )
  492.   (setq ei (subst (assoc 5 ei) (assoc 5 ent0) ent0)
  493.     ei (subst (cons 70 0) (assoc 70 ei) ei)
  494.   )
  495.   (if (= sz_color 0) (sz_b 62 ei62 256))
  496.   (if (= sz_layer 0) (setq ei (subst ei8 (assoc 8 ei) ei)))
  497.   (if (= sz_ltype 0) (sz_b 6 ei6 "BYLAYER"))
  498.   (if (= sz_ltsca 0) (sz_b 48 ei48 1.0))
  499.   (setq ei (subst (cons 12 (cdr ei10)) (assoc 10 ei) ei)
  500.     ei (subst (cons 10 (cdr ei11)) (assoc 10 ei) ei)
  501.     ei (subst ei10 (assoc 12 ei) ei)
  502.   )
  503.   (repeat 2 (setq ei (subst (cons 42 0.0) (assoc 42 ei) ei)))
  504.   (entdel eni)
  505.   (entmake ei)
  506. )

  508. (defun sz_circle(/ ei62 ei8 ei6 ei48 ei10 ei40 pt1 pt2)
  509.   (setq ei62 (assoc 62 ei)
  510.         ei8  (assoc 8 ei)
  511.         ei6  (assoc 6 ei)
  512.         ei48 (assoc 48 ei)
  513.         ei10 (cdr (assoc 10 ei))
  514.         ei40 (cdr (assoc 40 ei))
  515.     pt1  (cons (- (car ei10) ei40) (cdr ei10))
  516.     pt2  (cons (+ (car ei10) ei40) (cdr ei10))
  517.   )
  518.   (setq ei (subst (assoc 5 ei) (assoc 5 ent0) ent0)
  519.     ei (subst (cons 70 1) (assoc 70 ei) ei)
  520.   )
  521.   (if (= sz_color 0) (sz_b 62 ei62 256))
  522.   (if (= sz_layer 0) (setq ei (subst ei8 (assoc 8 ei) ei)))
  523.   (if (= sz_ltype 0) (sz_b 6 ei6 "BYLAYER"))
  524.   (if (= sz_ltsca 0) (sz_b 48 ei48 1.0))
  525.   (setq ei (subst (cons 12 pt1) (assoc 10 ei) ei)
  526.     ei (subst (cons 10 pt2) (assoc 10 ei) ei)
  527.     ei (subst (cons 10 pt1) (assoc 12 ei) ei)
  528.   )
  529.   (repeat 2 (setq ei (subst (cons 42 1.0) (assoc 42 ei) ei)))
  530.   (entdel eni)
  531.   (entmake ei)
  532. )

  534. (defun sz_arc(/ ei62 ei8 ei6 ei10 ei48 ei40 ei50 ei51 pt1 pt2 lpt alf e42)
  535.   (setq ei62 (assoc 62 ei)
  536.         ei8  (assoc 8 ei)
  537.         ei6  (assoc 6 ei)
  538.         ei48 (assoc 48 ei)
  539.         ei10 (cdr (assoc 10 ei))
  540.         ei40 (cdr (assoc 40 ei))
  541.         ei50 (cdr (assoc 50 ei))
  542.         ei51 (cdr (assoc 51 ei))
  543.     pt1  (list (+ (car ei10) (* ei40 (cos ei50)))
  544.            (+ (cadr ei10) (* ei40 (sin ei50))) (caddr ei10))
  545.     pt2  (list (+ (car ei10) (* ei40 (cos ei51)))
  546.            (+ (cadr ei10) (* ei40 (sin ei51))) (caddr ei10))
  547.     lpt  (/ (distance pt1 pt2) 2.0)
  548.     alf  (- ei51 ei50)
  549.   )
  550.   (setq ei (subst (assoc 5 ei) (assoc 5 ent0) ent0)
  551.     ei (subst (cons 70 0) (assoc 70 ei) ei)
  552.   )
  553.   (if (= sz_color 0) (sz_b 62 ei62 256))
  554.   (if (= sz_layer 0) (setq ei (subst ei8 (assoc 8 ei) ei)))
  555.   (if (= sz_ltype 0) (sz_b 6 ei6 "BYLAYER"))
  556.   (if (= sz_ltsca 0) (sz_b 48 ei48 1.0))
  557.   (setq ei (subst (cons 12 pt1) (assoc 10 ei) ei)
  558.     ei (subst (cons 10 pt2) (assoc 10 ei) ei)
  559.     ei (subst (cons 10 pt1) (assoc 12 ei) ei)
  560.   )
  561.   (if (or (> alf pi) (and (< alf 0) (> alf (- pi))))
  562.     (setq e42 (/ (+ ei40 (sqrt (- (* ei40 ei40) (* lpt lpt)))) lpt)
  563.       ei  (subst (cons 42 e42) (assoc 42 ei) ei)
  564.     )
  565.     (setq e42 (/ (- ei40 (sqrt (- (* ei40 ei40) (* lpt lpt)))) lpt)
  566.       ei  (subst (cons 42 e42) (assoc 42 ei) ei)
  567.     )
  568.   )
  569.   (entdel eni)
  570.   (entmake ei)
  571. )

  573. (defun sz_ss()
  574.   (setq wd1 "\n当前匹配属性：" wd0 "不匹配属性：")
  575.   (if (= sz_color 1) (setq wd1 (strcat wd1 " 颜色")) (setq wd0 (strcat wd0 " 颜色")))
  576.   (if (= sz_layer 1) (setq wd1 (strcat wd1 " 图层")) (setq wd0 (strcat wd0 " 图层")))
  577.   (if (= sz_ltype 1) (setq wd1 (strcat wd1 " 线形")) (setq wd0 (strcat wd0 " 线形")))
  578.   (if (= sz_ltsca 1) (setq wd1 (strcat wd1 " 线形比例")) (setq wd0 (strcat wd0 " 线形比例")))
  579.   (if (= sz_asywh 1) (setq wd1 (strcat wd1 " 变宽线形")) (setq wd0 (strcat wd0 " 变宽线形")))
  580.   (if (= wd1 "\n当前匹配属性：") (setq wd1 "\n当前匹配属性：宽度")(setq wd1 (strcat wd1 "。")))
  581.   (if (= wd0 "不匹配属性：") (setq wd0 "") (setq wd0 (strcat wd0 "。")))
  582.   (princ (strcat "\n***" wd1 wd0))
  583.   (initget "Setting  ")
  584.   (setq ent1(entsel "\n设置匹配属性S/<拾取参考宽度多义线：>"))
  585.   (if (= ent1 "Setting")
  586.     (progn
  587.       (sz_s)
  588.       (sz_ss)
  589.     )
  590.     (progn
  591.       (if ent1
  592.         (if (/= (type ent1) 'STR)
  593.           (progn
  594.             (if (/= (cdr (assoc 0 (entget (car ent1)))) "LWPOLYLINE") (sz_ss))
  595.             (if (not (assoc 43 (entget (car ent1)))) (sz_ss))
  596.           )
  597.         )
  598.         (sz_ss)
  599.       )
  600.     )
  601.   )
  602. )

  604. (defun c:xk(/ ent1 ent0 wd0 wd1 setk ss1 len i e62 e8 e6 e48 e90 e43 ei eni)
  605.   (command "color" (getvar "cecolor"))
  606.   (if (not sz_color) (setq sz_color 1))
  607.   (if (not sz_layer) (setq sz_layer 1))
  608.   (if (not sz_ltype) (setq sz_ltype 1))
  609.   (if (not sz_ltsca) (setq sz_ltsca 1))
  610.   (if (not sz_asywh) (setq sz_asywh 0))
  611.   (sz_ss)
  612.   (if (/= (type ent1) 'STR)
  613.     (progn
  614.       (princ "\n拾取欲变宽度的线实体：")
  615.       (setq ss1 (ssget '((-4 . "<OR")(0 . "CIRCLE")(0 . "LINE")(0 . "ARC")(0 . "LWPOLYLINE")(-4 . "OR>"))))   
  616.       (if ss1
  617.         (sz_main)
  618.       )
  619.     )
  620.   )
  621.   (princ)
  622. )

  624. (defun c:jg()
  625. (alert "  《工具刷合集》\n    版本：V1.1 \n 自由软件，欢迎转载\n作者：国电南自 郎建山\n")
  626. )
网上

相关帖子
回复

使用道具 举报

3wlds
 楼主| 发表于 2014-12-26 14:04:32 | 显示全部楼层
重新发了一次 ，刚刚那个操作失误
回复 支持 反对

使用道具 举报

wzg356
发表于 2014-12-26 16:26:48 | 显示全部楼层
那么长，问作者
回复 支持 反对

使用道具 举报

3wlds
 楼主| 发表于 2014-12-27 11:30:26 | 显示全部楼层
觉得 后面好长的是别的命令了
回复 支持 反对

使用道具 举报

ZZXXQQ
发表于 2014-12-27 12:34:00 | 显示全部楼层
本帖最后由 ZZXXQQ 于 2014-12-27 13:02 编辑
  2. (defun c:js (/ uu txt3 ent)
  3. (if (not(wcmatch fuh "+,-,*,/")) (setq fuh "*"))
  4. (if (not(wcmatch mos "a,b")) (setq mos "a"))
  5. (setq txt1 (getstring (strcat "\n请输入运算符号[加(+)/减(-)/乘(*)/除(/)] <" fuh ">:")))
  6. (if (apply 'and (mapcar '(lambda (x) (/= txt1 x)) '("+" "-" "*" "/" ""))) (exit))
  7. (if (= txt1 "") (setq txt1 fuh) (setq fuh txt1))
  8. (setq zz (getstring (strcat "\n请输入模式[单步(A)/连续(B)] <" (strcase mos)">:")))
  9. (if (apply 'and (mapcar '(lambda (x) (/= zz x)) '("a" "b" ""))) (exit))
  10. (if (= zz "") (setq zz mos) (setq mos zz))
  11. (setq zz (strcase zz T))
  12. (setq uu (strcat txt1 zz))
  13. (jisuan txt1 zz)
  14. (princ)
  15. )
  16. (defun jisuan (fun ab)
  17.   (setq yslst '(("+" . "加") ("-" . "减") ("*" . "乘") ("/" . "除")))
  18.   (setq tmp (cdr(assoc fun yslst)))
  19.   (setq lx (cdr(assoc ab '(("a" . "单步") ("b" . "连续")))))
  20.   (princ (strcat "\n " lx tmp "法运算: "))
  21.   (if (= ab "a") (progn
  22.     (setq ent (car(entsel (strcat "\n选择第一个" tmp "数: "))))
  23.     (setq txt2 (entget ent))
  24.     (setq txt2 (atof (cdr (assoc 1 txt2))))
  25.     (princ (rtos txt2))
  26.     (setq ent (car(entsel (strcat "\n选择第二个" tmp "数: "))))
  27.     (setq txt3 (entget ent))
  28.     (setq txt3 (atof (cdr (assoc 1 txt3))))
  29.     (princ (rtos txt3))
  30.     (setq sum ((read fun) txt2 txt3))
  31.     (princ (strcat "\n两数的" tmp "法运算为: " (rtos sum 2)))
  32.   ) (progn
  33.     (setq ent (car (entsel "\n选择第一个数: ")))
  34.     (setq sum (atof (cdr (assoc 1 (entget ent))))
  35.     (princ (rtos sum))
  36.     (prompt (strcat "\n请选择" tmp "数: "))
  37.     (if (setq sstext (ssget '((0 . "*TEXT")))) (progn
  38.      (setq mm 0)
  39.      (princ (strcat "选择的" tmp "数: "))
  40.      (repeat (setq len (sslength sstext))
  41.        (setq txtent (ssname sstext (setq len (1- len))))
  42.        (setq modeltxt (cdr (assoc 1 (entget txtent))))
  43.        (setq sum ((read fun) sum (atof modeltxt)))
  44.        (setq mm (1+ mm))
  45.        (princ (strcat "\n   第" (itoa mm) tmp "数:"))
  46.        (princ modeltxt)
  47.      )
  48.    ))
  49.    (princ (strcat "\n计算的结果为:" (rtos sum 2)))
  50.   ))
  51.   (setq ent (car (entsel "\n选择结果的位置: ")))
  52.   (princ "完成")
  53.   (setq ent (entget ent))
  54.   (entmod (subst (cons 1 (rtos sum 2 2)) (assoc 1 ent) ent))
  55. )
回复 支持 反对

使用道具 举报

ll_j
发表于 2014-12-27 15:53:35 | 显示全部楼层
到我的网络U盘下载一个ce.lsp试试。
回复 支持 反对

使用道具 举报

3wlds
 楼主| 发表于 2014-12-27 18:01:39 | 显示全部楼层
ll_j 发表于 2014-12-27 15:53
到我的网络U盘下载一个ce.lsp试试。

好的 多谢 我去试试
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-23 15:42 , Processed in 0.205716 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表