Question

分享几个简单的LISP实用小程序

Answer 1

(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。这几个命令基本上会用到