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)
Link tải (MediaFire)
📥 https://www.mediafire.com/
---------------------------------------------------------------------------------------------
Mọi thông tin xin liên hệ Fanpage AutoLISP Thật là đơn giản!
Cảm ơn bạn đã theo dõi!
Không có nhận xét nào:
Đăng nhận xét