26/11/2024

Lisp Chèn block vào đỉnh pline | AutoLISP Insert block every vertexs of a lw polyline | AutoLISP Reviewer

Ứng dụng được phát triển bởi đội ngũ AutoLISP Thật là đơn giản
   

Thông tin thêm: 👉👉👉

Chèn block vào đỉnh Pline

1 Thêm class AJS_InsertBlockPlines.lsp

Lưu mã sau dưới dạng tệp tin AJS_InsertBlockPlines.lsp
Code:
(vl-load-com)
(defun c:AJS_InsertBlockPlines (/ blk cnt c_spc ent m_dst m_pt n_obj r_ang sca ss)
	;; Check that we have the block to insert
	(setq blkname (getstring "\nSpecify block's name: "))
	(if (and blkname (tblobjname "block" (setq blk blkname)))
		(progn 
			(setq c_spc (vlax-get-property
				(vla-get-activedocument (vlax-get-acad-object))
				(if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
				)
				sca   1.		; < - Block scale
			)
			(prompt "\nSelect ARC,LINE,*POLYLINE,SPLINE: ")
			;; Check for selection or (sslength nil) below will bomb
			(setq ss (ssget '((0 . "ARC,LINE,LWPOLYLINE,POLYLINE,SPLINE"))))
			(cond (ss
			(repeat (setq cnt (sslength ss))
				(setq ent (ssname ss (setq cnt (1- cnt))))
				(setq i 0)
				(while (< i (vlax-curve-getEndParam ent)) ;get the number of vertex in the polyline
					(setq p1 (vlax-curve-getPointAtParam ent i) ;get point at i
						p2 (vlax-curve-getPointAtParam ent (1+ i)) ;get point at next vertex
						ang (angle p1 p2)
					)
					(setq i (1+ i))

					(setq m_pt p1)
					(setq r_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent m_pt))))
					(vlax-invoke c_spc 'insertblock m_pt blk sca sca sca r_ang)
				)
			);end_setq
			);end_repeat
			)
		)
		(alert (strcat "\n" blk " needs to exist in drawing!"))
	)
	(princ "\nEdited by www.lisp.vn")
	(princ)
)
Lưu ý: Nếu không muốn xoay block theo Pline thì bỏ dòng sau: (setq r_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent m_pt))))

Chèn Block vào Trung điểm Pline

2 Thêm class AJS_InsertBlockPlinesMid.lsp

Lưu mã sau dưới dạng tệp tin AJS_InsertBlockPlinesMid.lsp
Code:
(vl-load-com)
(defun c:AJS_InsertBlockPlinesMid (/ blk cnt c_spc ent m_dst m_pt n_obj r_ang sca ss)
	;; Check that we have the block to insert
	(setq blkname (getstring "\nSpecify block's name: "))
	(if (and blkname (tblobjname "block" (setq blk blkname)))
		(progn 
			(setq c_spc (vlax-get-property
				(vla-get-activedocument (vlax-get-acad-object))
				(if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
				)
				sca   1.		; < - Block scale
			)
			(prompt "\nSelect ARC,LINE,*POLYLINE,SPLINE: ")
			;; Check for selection or (sslength nil) below will bomb
			(setq ss (ssget '((0 . "ARC,LINE,LWPOLYLINE,POLYLINE,SPLINE"))))
			(cond 
				(ss
					(repeat (setq cnt (sslength ss))
						(setq ent (ssname ss (setq cnt (1- cnt))))
						(setq m_dst (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2)
							m_pt (vlax-curve-getpointatdist ent m_dst)
							r_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent m_pt)))
							n_obj (vlax-invoke c_spc 'insertblock m_pt blk sca sca sca r_ang)
						);end_setq
					);end_repeat
				)
			)
		)
		(alert (strcat "\n" blk " needs to exist in drawing!"))
	)
	(princ "\nEdited by www.lisp.vn")
	(princ)
)
Lưu ý: Nếu không muốn xoay block theo Pline thì bỏ dòng sau: r_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent m_pt)))

Link tải


Nguồn tham khảo



---------------------------------------------------------------------------------------------
Ứng dụng được phát triển bởi đội ngũ AutoLISP Thật là đơn giản - Tác giả ứng dụng in D2P

    

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

Hàm COUNTIFS đếm theo nhiều điều kiện trong Excel | COUNTIFS, COUNTIF | AutoLISP Reviewer

Hàm COUNTIFS đếm theo nhiều điều kiện trong Excel Cuối tháng cần biết phòng Kế toán có bao nhiêu người đi làm đủ công, bao nhiêu đơn hàng ...