Lệnh sử dụng VZ

Lisp vẽ dây đi ống box điện nhanh.

Tác giả Phuc Le

1 Thêm class Ve day box (VZ)_update_select_block.lsp

Lưu mã sau dưới dạng tệp tin Ve day box (VZ)_update_select_block.lsp

Code:

;; Lisp ve day di ong box dien nhanh
;; Rev01 - Phuc Le - 2025.10.31 00:10 (UTC+7)

(defun c:VZ ( / gc:clockwise-p *my_error* start_undo end_undo vz:setting AT:GetSel olderr curr_osmode p1 blk_ent p2 pV1 PV2 pSide entlist )
	;; Clockwise-p  -  gile
	;; Returns T if p1,p2,p3 are clockwise oriented
	(defun gc:clockwise-p ( p1 p2 p3 )
		(< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
	)
	;; Collinear-p  -  Lee Mac
	;; Returns T if p1,p2,p3 are collinear
	(defun LM:Collinear-p ( p1 p2 p3 )
		(
			(lambda ( a b c )
				(or
					(equal (+ a b) c 1e-8)
					(equal (+ b c) a 1e-8)
					(equal (+ c a) b 1e-8)
				)
			)
			(distance p1 p2) (distance p2 p3) (distance p1 p3)
		)
	)
	;; Error trap
	(defun *my_error* ( msg )
		(if curr_osmode (setvar 'osmode curr_osmode))
		(if olderr (setq *error* olderr))
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ (strcat "\nError: " msg))
		)
		(princ)
	)
	;; Undo
	(defun start_undo nil
		(if (= 0 (getvar 'cmdecho)) (command "undo" "be") (progn (setvar 'cmdecho 0) (command "undo" "be")))
	)
	(defun end_undo nil
		(if (= 0 (getvar 'cmdecho)) (progn (command "undo" "end") (setvar 'cmdecho 1)) (progn (setvar 'cmdecho 0) (command "undo" "end") (setvar 'cmdecho 1)))
	)
	;; Getsel
	(defun AT:GetSel (meth msg fnc / ent good)
		 ;; meth - selection method (entsel, nentsel, nentselp)
		 ;; msg - message to display (nil for default)
		 ;; fnc - optional function to apply to selected object
		 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
		 ;; Alan J. Thompson, 05.25.10
		(setvar 'errno 0)
		(while (not good)
			(setq ent (meth (cond (msg)
								("\nSelect sample object: ")
							)
						)
			)
			(cond
				((vl-consp ent)
					(setq good (if (or (not fnc) (fnc ent))
									ent
									(prompt "\n: Invalid object!")
								)
					)
				)
				((eq (type ent) 'STR) (setq good ent))
				((setq good (eq 52 (getvar 'errno))) nil)
				((eq 7 (getvar 'errno)) (setq good (prompt "\n: Missed, try again.")))
			)
		)
	)
	;; Get effective block name By Pham Hoang Nhat
	(defun GET_EFFECTIVENAME_BLOCK ( VlaObject / NameBlock)
		(vl-catch-all-apply (function (lambda ( / )
			(setq NameBlock (cdr (assoc 2 (entget (cdr (assoc 340 (entget (vlax-vla-object->ename (vla-item (vla-item (vla-GetExtensionDictionary VlaObject) "AcDbBlockRepresentation") "AcDbRepData")))))))))
		)))
		(if (not NameBlock)
			(setq NameBlock (cdr (assoc 2 (entget (vlax-vla-object->ename VlaObject)))))
		)
		NameBlock
	)
	;; setting
	(defun vz:setting ( / tmp)
		(setq fill_rad (cond ( (getreal (strcat "\nFillet Radius: <" (rtos (setq fill_rad (cond ( fill_rad ) ( (getvar 'filletrad) ))))">: "))) ( fill_rad )))
		(or join_p (setq join_p "Yes"))
		(initget "Yes No")
		(if (setq tmp (getkword (strcat "\nJoin into one Polyline ? [Yes/No] <" join_p ">: ")))
			(setq join_p tmp)
		)
	)
	;; sample block name
	(defun get_sample_block_name ( / blk)
		(if (setq blk 
				(AT:GetSel entsel "\n  Pick sample block for wiring " 
					(lambda (x) 
						(and
							(eq (cdr (assoc 0 (entget (car x)))) "INSERT") 
							(not (vlax-property-available-p (vlax-ename->vla-object (car x)) 'path))
							(not (wcmatch (GET_EFFECTIVENAME_BLOCK (vlax-ename->vla-object (car x))) "`*[DTUPM]*"))
						)
					)
				)
			)
			(progn
				(setq blkname_vz (GET_EFFECTIVENAME_BLOCK (vlax-ename->vla-object (car blk))))
				(princ (strcat "\n: User selected block named \"" blkname_vz "\" \n"))
			)
		)
	)
	;; checking for valid input data
	(if (or (not (numberp fill_rad)) (not (member join_p '( "Yes" "No")))) (vz:setting))
	(if blkname_vz
		nil 
		(progn 
			(while (not blkname_vz)
				(princ "\n: Pick sample block for wiring or <Esc> to cancel !\n")
				(get_sample_block_name)
			)
		)
	)
	;; Main code start here
	(princ (strcat "\n: --> Block name \"" blkname_vz  "\", " (if (= join_p "Yes") "join polyline" "No join polyline") ", Fillet radius = " (rtos (abs fill_rad) 2 2) " \n"))
	(setq olderr *error* curr_osmode (getvar 'osmode))
	(cond
		(	(setq p1
				(cond
					(
						(setq blk_ent
							(car
								(AT:GetSel entsel "\n Select 1st block <or Enter to setting>\n"
									(lambda (x) 
										(and
											(eq (cdr (assoc 0 (entget (car x)))) "INSERT")
											(= (GET_EFFECTIVENAME_BLOCK (vlax-ename->vla-object (car x))) blkname_vz)
										)
									)
								)
							)
						)
						(cdr (assoc 10 (entget blk_ent)))
					)
					( t nil )
				)
			)
			(start_undo)
			(setq *error* *my_error*)
			(setvar 'filletrad (abs fill_rad))
			(setq entlist (ssadd))
			(while 
				(setq p2
					(cond
						(
							(setq blk_ent
								(car
									(AT:GetSel entsel (strcat "\n Select next block " (if (< 0 (sslength entlist)) "or <Enter to finish>\n" "\n"))
										(lambda (x) 
											(and
												(eq (cdr (assoc 0 (entget (car x)))) "INSERT")
												(= (GET_EFFECTIVENAME_BLOCK (vlax-ename->vla-object (car x))) blkname_vz)
											)
										)
									)
								)
							)
							(cdr (assoc 10 (entget blk_ent)))
						)
						( t nil)
					)
				)
				(cond
					(	(and (equal (car p1) (car p2) 50.0) (equal (cadr p1) (cadr p2) 50.0))
						(princ "\n: Too close, please try another block !\n")
					)
					(	(or (= (car p1) (car p2)) (= (cadr p1) (cadr p2)))
						(setvar 'osmode 16384)
						(command "PLINE" p1 p2 "")
						(setvar 'osmode curr_osmode)
						(setq entlist (ssadd (entlast) entlist))
						(setq p1 p2)
					)
					(	t
						(setq pV1 (list (car p1 ) (cadr p2) (caddr p1)))
						(setq pV2 (list (car p2 ) (cadr p1) (caddr p2)))
						(while (and (setq pSide (getpoint "\nChoose the side for wiring: " )) (LM:Collinear-p pSide p1 p2))
							(setq pSide nil)
							(princ "\n: 3 points collinear, please try another point !\n")
						)
						(if pSide
							(progn
								(if (gc:clockwise-p p1 pSide p2 )
									(progn	
										(setvar 'osmode 16384)
										(cond
											(	(gc:clockwise-p p1 pV1 p2 )
												(command "PLINE" p1 pV1 p2 "")
											)
											(	(gc:clockwise-p p1 pV2 p2 )
												(command "PLINE" p1 pV2 p2 "")
											)
										)
									)
									(progn
										(setvar 'osmode 16384)
										(cond
											(	(not (gc:clockwise-p p1 pV1 p2 ))
												(command "PLINE" p1 pV1 p2 "")
											)
											(	(not (gc:clockwise-p p1 pV2 p2 ))
												(command "PLINE" p1 pV2 p2 "")
											)
										)
									)
								)
								(setvar 'osmode curr_osmode)
								(command "_.fillet" "_P" (entlast))
								(setq entlist (ssadd (entlast) entlist))
								(setq p1 p2)
							)
							(princ "\n: Reference point not selected, re-select 2nd point or <Enter to finish command> !\n")
						)
					)
				)
			)
			(if (and (< 1 (sslength entlist)) (= join_p "Yes"))
				(command "_.pedit" "_M" entlist "" "_J" "" "")
			)
			(setq *error* olderr)
			(end_undo)
		)
		(	t
			(vz:setting)
			(get_sample_block_name)
			(c:VZ)
		)
	)
	(princ)
)
(princ "\n: Type VZ to invoke command \n")
(princ)