麻烦高手查看一下,我这个显示有多余的闭括号,导致批量打印自动不加载.

yoyrtweq

取明经,用明经,这是明经高手写的,我仅修改了图层内容,其他未变.此为源码,显示有多余的闭括号,导致批量打印和一些插件自动不加载.请看下:
(defun xlr-autolayer ()
;  (setvar "cmdecho" 0)
;  (if (null (tblsearch "layer" "text"))
;    (set_layer_list "text" 3 "continuous")
;  )
;  (if (null (tblsearch "layer" "dim"))
;    (set_layer_list "dim" 3 "continuous")
;  )

  (vl-load-com)
  ;; 图层初始化列表 内容：commands layers color linetype plottable
  (setq *doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq *lays (vla-get-layers *doc))
  (setq *laylst
(list (list "QLEADER" "图标" 12 "CONTINUOUS" T)
          (list "DTEXT" "图标" 12 "CONTINUOUS" T)
          (list "MTEXT" "图标" 12 "CONTINUOUS" T)
          (list "TEXT" "图标" 12 "CONTINUOUS" T)
          (list "CIRCLE" "2 家具-内轮廓线" 7 "CONTINUOUS" T)
          (list "ARC" "1 家具-外轮廓线" 7 "CONTINUOUS"  T)
          (list "PLINE" "1 家具-外轮廓线" 7 "CONTINUOUS" T)
          (list "XLINE" "Defpoints" 5 "CONTINUOUS" T)
          (list "SPLINE" "1 家具-外轮廓线" 7 "CONTINUOUS" T)
          (list "RECTANG" "1 家具-外轮廓线" 7 "CONTINUOUS" T)
          (list "CIRCLE" "1 家具-外轮廓线" 7 "CONTINUOUS" T)
          (list "LINE" "2 家具-内轮廓线" 7 "CONTINUOUS" T)
          (list "MVIEW" "Defpoints" 5 "CONTINUOUS" T)
          (list "HATCH" "3 家具-填充线" 34 "CONTINUOUS" T)
          (list "BHATCH" "3 家具-填充线" 34 "CONTINUOUS" T)  
  )
  )
  (setq OldLayer nil)
  (setq *cmdlst (mapcar 'strcase (mapcar 'car *laylst)))
  (mapcar '(lambda (x) (vlr-command-reactor nil x))
   (list '((:vlr-commandWillStart . xlr-start))
  '((:vlr-commandEnded . xlr-end))
  '((:vlr-commandCancelled . xlr-cancel))
   )
  )
  (vlr-editor-reactor
    nil
    '((:vlr-commandwillstart . xlr-edit))
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-edit (CALL CALLBACK /)
  (foreach N *laylst
    (if (= (strcase (car CALLBACK)) (strcase (car N)))
     ; 命令反应器返回信息如果与设置的命令相同.
      (progn    ;建立图层
(apply 'xsetlays (cdr N))
     ;(setvar "CLAYER" (cadr N));设为当前层.
      )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-start (calling-reactor xlr-startInfo /)
  (foreach N *laylst
    (if (= (strcase (car xlr-startInfo)) (strcase (car N)))
     ; 命令反应器返回信息如果与设置的命令相同.
      (progn    ;建立图层
(apply 'xsetlays (cdr N))
     ;(setvar "CLAYER" (cadr N));设为当前层.
      )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-end (calling-reactor xlr-endInfo / cmd)
  (setq cmd (car xlr-endInfo))
  (if (member cmd *cmdlst)
    (if (/= oldlayer nil)
       (progn
           (setvar "CLAYER" OldLayer)
           (setq OldLayer nil)
       )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-cancel (calling-reactor xlr-cancelInfo / cmd)
  (setq cmd (car xlr-cancelInfo))
  (if (member cmd *cmdlst)
    (if (/= oldlayer nil)
       (progn
           (setvar "CLAYER" OldLayer)
           (setq OldLayer nil)
       )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
;;;----------------------------------------------------------------------------;;;
(defun xsetlays (LAY-NAM COLOR LTYPE plotk / LAYOBJ LTYPESOBJ)
  (if (tblobjname "layer" LAY-NAM)
    (progn
      (if (/= (strcase (getvar "CLAYER"))
       (strcase LAY-NAM)
   )
(setq OldLayer (getvar "CLAYER"))
(progn
   (if (= oldlayer nil)
     (setq OldLayer LAY-NAM)
   )
)
      )
      (setvar "CLAYER" lay-nam)
    )
    (progn    ;添加图层.
      (vl-catch-all-error-p
(vl-catch-all-apply 'vla-add (list *lays LAY-NAM))
      )
      (setq LAYOBJ (vla-item *lays LAY-NAM))
      (if (not (tblobjname "ltype" LTYPE)) ;添加线型.
(progn
   (setq LTYPESOBJ (vla-get-linetypes *doc))
   (vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
     ;>>>　要加强，在多个*.lin寻找
   (vlax-release-object LTYPESOBJ)
)
      )     ;解冻(如冻结)，解锁,设图层为当前,设图层颜色，可打印特性.
      (vla-put-layeron layobj :vlax-true)
      (vla-put-lock layobj :vlax-false)
      (if (= (strcase (getvar "CLAYER")) (strcase lay-nam)) ;解冻.
(vla-put-freeze layobj :vlax-false)
      )
      (vla-put-color layobj color)
      (vla-put-linetype layobj LTYPE)
      (vla-put-plottable
layobj
(if plotk
   :vlax-true
   :vlax-false
)
      )
    )
  )
)
(xlr-autolayer)    ;加载启动!
(princ "")
)
;;;----------------------------------------------------------------------------;;;
;;;----------------------------------------------------------------------------;;;
(defun xsetlays  (lay-nam color ltype plotk / layobj ltypesobj)
  (defun layeron (layername / layerdata)
    (setq layerdata (entget (tblobjname "LAYER" layername)))
    (if (< (cdr (assoc 62 layerdata)) 0)
      (progn
        (setq layerdata (subst
                          (cons 62 (- 0 (cdr (assoc 62 layerdata))))
                          (assoc 62 layerdata)
                          layerdata
                        )
        )
        (entmod layerdata)
      )
    )
  )
  (if (tblobjname "layer" lay-nam)
    (progn
      (if (/= (strcase (getvar "clayer")) (strcase lay-nam))
        (setq oldlayer (getvar "clayer"))
        (progn
          (if (= oldlayer nil)
            (setq oldlayer lay-nam)
          )
        )
      )
      (layeron lay-nam)
      (setvar "clayer" lay-nam)
    )
    (progn
      (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list *lays lay-nam)))
      (setq layobj (vla-item *lays lay-nam))
      (if (not (tblobjname "ltype" ltype)) ;添加线型.
        (progn
          (setq ltypesobj (vla-get-linetypes *doc))
          (vla-load ltypesobj ltype (findfile "acad.lin"))  ;>>>　要加强，在多个*.lin寻找
          (vlax-release-object ltypesobj)
        )
      )
      (vla-put-layeron layobj :vlax-true)
      (vla-put-lock layobj :vlax-false)
      (if (= (strcase (getvar "clayer")) (command "layer" "on" "" "")(strcase lay-nam)) ;解冻.
        (vla-put-freeze layobj :vlax-false)
      )
      (vla-put-color layobj color)
      (vla-put-linetype layobj LTYPE)
      (vla-put-plottable layobj (if plotk :vlax-true :vlax-false))
    )
  )

烟盒迷唇

(defun xlr-autolayer ()
        ;  (setvar "cmdecho" 0)
        ;  (if (null (tblsearch "layer" "text"))
        ;    (set_layer_list "text" 3 "continuous")
        ;  )
        ;  (if (null (tblsearch "layer" "dim"))
        ;    (set_layer_list "dim" 3 "continuous")
        ;  )
       
  (vl-load-com)
  ;; 图层初始化列表 内容：commands layers color linetype plottable
  (setq *doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq *lays (vla-get-layers *doc))
  (setq *laylst
                (list (list "QLEADER" "图标" 12 "CONTINUOUS" T)
                        (list "DTEXT" "图标" 12 "CONTINUOUS" T)
                        (list "MTEXT" "图标" 12 "CONTINUOUS" T)
                        (list "TEXT" "图标" 12 "CONTINUOUS" T)
                        (list "CIRCLE" "2 家具-内轮廓线" 7 "CONTINUOUS" T)
                        (list "ARC" "1 家具-外轮廓线" 7 "CONTINUOUS"  T)
                        (list "PLINE" "1 家具-外轮廓线" 7 "CONTINUOUS" T)
                        (list "XLINE" "Defpoints" 5 "CONTINUOUS" T)
                        (list "SPLINE" "1 家具-外轮廓线" 7 "CONTINUOUS" T)
                        (list "RECTANG" "1 家具-外轮廓线" 7 "CONTINUOUS" T)
                        (list "CIRCLE" "1 家具-外轮廓线" 7 "CONTINUOUS" T)
                        (list "LINE" "2 家具-内轮廓线" 7 "CONTINUOUS" T)
                        (list "MVIEW" "Defpoints" 5 "CONTINUOUS" T)
                        (list "HATCH" "3 家具-填充线" 34 "CONTINUOUS" T)
                        (list "BHATCH" "3 家具-填充线" 34 "CONTINUOUS" T)  
                )
  )
  (setq OldLayer nil)
  (setq *cmdlst (mapcar 'strcase (mapcar 'car *laylst)))
  (mapcar '(lambda (x) (vlr-command-reactor nil x))
                (list '((:vlr-commandWillStart . xlr-start))
                        '((:vlr-commandEnded . xlr-end))
                        '((:vlr-commandCancelled . xlr-cancel))
                )
  )
  (vlr-editor-reactor
    nil
    '((:vlr-commandwillstart . xlr-edit))
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-edit (CALL CALLBACK /)
  (foreach N *laylst
    (if (= (strcase (car CALLBACK)) (strcase (car N)))
                        ; 命令反应器返回信息如果与设置的命令相同.
      (progn    ;建立图层
                                (apply 'xsetlays (cdr N))
                                ;(setvar "CLAYER" (cadr N));设为当前层.
      )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-start (calling-reactor xlr-startInfo /)
  (foreach N *laylst
    (if (= (strcase (car xlr-startInfo)) (strcase (car N)))
                        ; 命令反应器返回信息如果与设置的命令相同.
      (progn    ;建立图层
                                (apply 'xsetlays (cdr N))
                                ;(setvar "CLAYER" (cadr N));设为当前层.
      )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-end (calling-reactor xlr-endInfo / cmd)
  (setq cmd (car xlr-endInfo))
  (if (member cmd *cmdlst)
    (if (/= oldlayer nil)
                        (progn
                                (setvar "CLAYER" OldLayer)
                                (setq OldLayer nil)
                        )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-cancel (calling-reactor xlr-cancelInfo / cmd)
  (setq cmd (car xlr-cancelInfo))
  (if (member cmd *cmdlst)
    (if (/= oldlayer nil)
                        (progn
                                (setvar "CLAYER" OldLayer)
                                (setq OldLayer nil)
                        )
    )
  )
)
;;;----------------------------------------------------------------------------;;;
;;;----------------------------------------------------------------------------;;;
(defun xsetlays (LAY-NAM COLOR LTYPE plotk / LAYOBJ LTYPESOBJ)
  (if (tblobjname "layer" LAY-NAM)
    (progn
      (if (/= (strcase (getvar "CLAYER"))
                                                (strcase LAY-NAM)
                                        )
                                (setq OldLayer (getvar "CLAYER"))
                                (progn
                                        (if (= oldlayer nil)
                                                (setq OldLayer LAY-NAM)
                                        )
                                )
      )
      (setvar "CLAYER" lay-nam)
    )
    (progn    ;添加图层.
      (vl-catch-all-error-p
                                (vl-catch-all-apply 'vla-add (list *lays LAY-NAM))
      )
      (setq LAYOBJ (vla-item *lays LAY-NAM))
      (if (not (tblobjname "ltype" LTYPE)) ;添加线型.
                                (progn
                                        (setq LTYPESOBJ (vla-get-linetypes *doc))
                                        (vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
                                        ;>>>　要加强，在多个*.lin寻找
                                        (vlax-release-object LTYPESOBJ)
                                )
      )     ;解冻(如冻结)，解锁,设图层为当前,设图层颜色，可打印特性.
      (vla-put-layeron layobj :vlax-true)
      (vla-put-lock layobj :vlax-false)
      (if (= (strcase (getvar "CLAYER")) (strcase lay-nam)) ;解冻.
                                (vla-put-freeze layobj :vlax-false)
      )
      (vla-put-color layobj color)
      (vla-put-linetype layobj LTYPE)
      (vla-put-plottable
                                layobj
                                (if plotk
                                        :vlax-true
                                        :vlax-false
                                )
      )
    )
  )
        ;)
        (xlr-autolayer)    ;加载启动!
        (princ "")
)
;;;----------------------------------------------------------------------------;;;
;;;----------------------------------------------------------------------------;;;
(defun xsetlays  (lay-nam color ltype plotk / layobj ltypesobj)
  (defun layeron (layername / layerdata)
    (setq layerdata (entget (tblobjname "LAYER" layername)))
    (if (< (cdr (assoc 62 layerdata)) 0)
      (progn
        (setq layerdata (subst
                          (cons 62 (- 0 (cdr (assoc 62 layerdata))))
                          (assoc 62 layerdata)
                          layerdata
                        )
        )
        (entmod layerdata)
      )
    )
  )
  (if (tblobjname "layer" lay-nam)
    (progn
      (if (/= (strcase (getvar "clayer")) (strcase lay-nam))
        (setq oldlayer (getvar "clayer"))
        (progn
          (if (= oldlayer nil)
            (setq oldlayer lay-nam)
          )
        )
      )
      (layeron lay-nam)
      (setvar "clayer" lay-nam)
    )
    (progn
      (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list *lays lay-nam)))
      (setq layobj (vla-item *lays lay-nam))
      (if (not (tblobjname "ltype" ltype)) ;添加线型.
        (progn
          (setq ltypesobj (vla-get-linetypes *doc))
          (vla-load ltypesobj ltype (findfile "acad.lin"))  ;>>>　要加强，在多个*.lin寻找
          (vlax-release-object ltypesobj)
        )
      )
      (vla-put-layeron layobj :vlax-true)
      (vla-put-lock layobj :vlax-false)
      (if (= (strcase (getvar "clayer")) (command "layer" "on" "" "")(strcase lay-nam)) ;解冻.
        (vla-put-freeze layobj :vlax-false)
      )
      (vla-put-color layobj color)
      (vla-put-linetype layobj LTYPE)
      (vla-put-plottable layobj (if plotk :vlax-true :vlax-false))
    )
  )
)       

yoyrtweq

烟盒迷唇 发表于 2021-4-23 06:44
(defun xlr-autolayer ()
        ;  (setvar "cmdecho" 0)
        ;  (if (null (tblsearch "layer" "text"))

没问题了,我擦 我也应该学学LSP,老是麻烦群友大佬

yoyrtweq

烟盒迷唇 发表于 2021-4-23 06:44
(defun xlr-autolayer ()
        ;  (setvar "cmdecho" 0)
        ;  (if (null (tblsearch "layer" "text"))

使用了 ,添加到acad2012doc里面,但没启用,无效.  其他源码插件都启用了        使用lsp编辑器编译,还是能通过.不知道是哪里的问题