LISP语言的list如何实现插入 *** 作???

LISP语言的list如何实现插入 *** 作???,第1张

(defun c:chengxu (/ yuanshi aaa bbb test jieguo)

(setq yuanshi '(1 2 3 4 5))原始表

(setq aaa yuanshi)复制原始表,循环处理会改变,所以复制数据

(setq bbb yuanshi)复制原始表,循环处理会改变,所以复制数据

前段处理

(repeat 3 循环

(setq test (cons (car aaa) test))制作一个储存逆向数据的表

(setq aaa (cdr aaa))

)

(setq test (reverse test))逆转表

后端处理

(repeat 3 循环

(setq bbb (cdr bbb))

)

合并

(setq jieguo (append test '(9) bbb))

输出结果

(princ jieguo)

(princ)

)

核心就是append合并几个表而已

(defun c:qx ()     (setvar "cmdecho" 0)  (command "layon")  (setvar "cmdecho" 1) (prin1) ) 打开所有图层

(defun c:ff ()     (setvar "cmdecho" 0)  (command "layoff")  (setvar "cmdecho" 1) (prin1) ) 选择需要关闭的图层

(defun c:qw ()     (setvar "cmdecho" 0)  (command "layiso")  (setvar "cmdecho" 1) (prin1) ) 选择需要隔离的图层

(defun c:tc ()     (setvar "cmdecho" 0)  (command "laymcur")  (setvar "cmdecho" 1) (prin1) ) 选择对象为当前图层

(defun c:df ()     (setvar "cmdecho" 0)  (command "ribbon")  (setvar "cmdecho" 1) (prin1) ) 打开工具选项栏

(defun c:fd ()     (setvar "cmdecho" 0)  (command "ribbonclose")  (setvar "cmdecho" 1) (prin1) ) 关闭工具选项栏

 修改图层

(defun C:XG (/ #os1 &k1 #k1 %k1 &kw i %k2)

 (setvar "cmdecho" 0)

 (setvar "blipmode" 0)

 (setq #os1 (getvar "osmode"))

 (setvar "osmode" 0)

 (setq &k1 (entsel "\n请选择参考图层"))

 (if (= &k1 nil)

  (princ "\n没有选择参考图层")

 )

 (if (/= &k1 nil)

  (progn

   (setq &k1 (car &k1)

 #k1 (entget &k1)

 %k1 (assoc 8 #k1)

   )

   (princ "\n请选择需要改变的对象")

   (setq &kw (ssget))

   (if (= &kw nil)

    (princ "\n没有选择对象")

   )

   (if (/= &kw nil)

    (progn

     (setq i 0)

     (repeat (sslength &kw)

      (setq &k1 (ssname &kw i)

    #k1 (entget &k1)

    %k2 (assoc 8 #k1)

    #k1 (subst

 %k1

 %k2

 #k1

)

    i (+ i 1)

      )

      (entmod #k1)

     )

     (princ "\n改变图层完成")

    )

   )

  )

 )

 (setvar "osmode" #os1)

 (prin1)

)

一键所有填充对象置后显示,CAD2005以上版本适用 By Gu_xl 2014.07.17

(defun C:ZX5 (/ sortents dict  lst Doc)

 (setvar "cmdecho" 0)

 (setvar "blipmode" 0)

 (vl-load-com)

  (setq  doc

   (vla-get-ActiveDocument

     (vlax-get-acad-object)

   )

  )

  (vlax-for blockdef (vla-get-blocks doc)

    (cond

      (

       (not

   (VL-CATCH-ALL-ERROR-P

     (setq sortents

      (VL-CATCH-ALL-APPLY

        'vla-item

        (list

          (setq dict

           (vla-GetExtensionDictionary

             blockdef

           )

          )

          "ACAD_SORTENTS"

        )

      )

     )

   )

       )

      )

      ((setq sortents

        (VL-CATCH-ALL-APPLY

    'vla-AddObject

    (list dict "ACAD_SORTENTS" "AcDbSortentsTable")

        )

       )

      )

    )

    (setq lst nil)

    (vlax-for obj blockdef

      (if (= "AcDbHatch" (vla-get-objectname obj))

  (setq lst (cons obj lst))

      )

    )

    (if  lst

      (progn

  (vla-MoveToBottom

    sortents

    (vlax-make-variant

      (vlax-safearray-fill

        (vlax-make-safearray

    vlax-vbobject

    (cons 0 (1- (length lst)))

        )

        lst

      )

    )

  )

      )

    )

  )

  (vla-regen doc :vlax-true)

  (princ)

)

以上复制到记事本,以(.lsp)为后缀命名,加载autoLISP到AutoCAD。这几个命令基本上会用到

附上相关程序,请审核。

-------------------------解二元一次方程组------------------------

(defun 1y1c (a c) (if (/= a 0) (/ c (float a)))) 解一元一次方程 ax=c

(DEFUN 2Y1C (A1 B1 C1 A2 B2 C2 / x y) 二元一次方程组 A1x+B1y=C1

(IF (= A1 0) A2x+B2y=C2

(SETQ Y (1Y1C B1 C1))

(SETQ Y (1Y1C (- B2 (* (/ A2 (float A1)) B1)) (- C2 (* (/ A2 (float A1)) C1))))

)

(setq X (if y (1Y1C A2 (- C2 (* B2 Y)))))

(list x y)

)

-------------解一元二次方程------------------------------------

(defun 1y2c (a b c / d e f) 一元二次方程 Ax^2+Bx+C=0

(setq d (- (* b b) (* 4 a c))

e (/ b -2.0 a)

f (/ (sqrt (abs d)) 2 a)

)

(cond ((= d 0) (list e))

((>d 0) (list (+ e f) (- e f)))

((<d 0) (list e "+/-i" f))

)

)


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/11692578.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-18
下一篇 2023-05-18

发表评论

登录后才能评论

评论列表(0条)

保存