Nhờ chỉnh sửa lisp set lệnh

[thietke08 2]

Nhờ anh em giúp với, hiện mình có lisp này để tạo layer, nhưng hiện tại nhập lệnh phải qua 2 lần, như bên dưới phải nhập QQ rồi Q mới tạo layer được.

Nhờ anh em chỉnh về chỉnh nhập QQ là nó chạy lệnh luôn. Cảm ơn nhiều.

 

;-------------------------------------------------------------------------
; *** START MAIN FUNCTION ***
;-------------------------------------------------------------------------

(defun c:QQ ()

	(setq a
	   (strcase (getstring "\nChoose Layer group to load [Q] <Q>")
	   );strcase
	);setq
	(cond
		((= a "Q") (CLAYLA))

	);cond
    (princ)
 (princ)
); _end defun, LAY


;-------------------------------------------------------------------------
; *** LAYERS ***
;-------------------------------------------------------------------------

(defun CLAYLA (/ LayerList)
(setvar "cmdecho" 0)

; LAYER NAME:		COLOR:	LINETYPE:	DESCRIPTION:
(setq LayerList '
	(
	("0"	7	"Continuous"	"VNLA")
	("DEFPOINTS"	9	"Continuous"	"VNLA")
	("R-REVISION-DEF"	9	"Continuous"	"KTV Old Revision")
	("A-BLDG" 8 "Continuous" "VNLA - Cong trinh")
	("A-BLDG-PROP" 2 "Continuous" "VNLA - Ranh cong trinh")
	("A-BLDG-HTCH" 9 "Continuous" "VNLA - Hatch cong trinh")
	("A-COLUMN" 2 "Continuous" "VNLA - Cot KT")

 )
)

; SEND LAYER LIST TO "Processlayers" FUNCTION.
(ProcessLayers)
(command "-layer"	"p"	"n"	"L-VIEW-VP" "")

(alert "VNLA LAYERS HAVE BEEN ADDED SUCCESSFULLY!")
(setvar "cmdecho" 1)
(setvar "clayer" "0")


); _end defun, CLAYL


;-------------------------------------------------------------------------
; *** LANDSCAPE LAYERS ***
;-------------------------------------------------------------------------

;-------------------------------------------------------------------------
; *** PROCESS ALL LAYERS ***
;-------------------------------------------------------------------------

(defun ProcessLayers (/ doc LayerCollection)

(vl-load-com)

; SETQ "DOC" TO THE ACTIVE DOCUMENT.
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))

; GET THE "LAYER COLLECTION".
(setq LayerCollection (vla-Get-Layers doc))

; CREATE ALL LAYERS AND ASSIGN COLOR, LINETYPE AND DESCRIPTION.
(mapcar '(lambda (x)
 (setq NewLayer (vla-add LayerCollection (nth 0 x)))		; CREATE A NEW LAYER.
 (vla-put-color NewLayer (nth 1 x))				; ADD A COLOR TO THE LAYER.

 (if (not (tblobjname "ltype" (nth 2 x)))			; IF LINETYPE DOESN'T EXIST, LOAD IT. (STANDARD ACAD LINETYPES)
  (vla-load (vla-Get-Linetypes doc) (nth 2 x) "acad.lin")
 ); _end if
 (vla-put-linetype NewLayer (nth 2 x))				; ADD A LINETYPE TO THE LAYER.
 (vla-put-Description NewLayer (nth 3 x))			; ADD A DESCRIPTION TO THE LAYER.
 ); _end lambda

 LayerList							; LAYER LIST.
); _end mapcar

); _end defun, ProcessLayers

 

[7o7 81]

Đây bạn.

QQ.lsp