Thứ Hai, 25 tháng 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

Fillet bo tròn nhiều đa giác trong AutoCAD | Multiple fillet polylines in AutoCAD | AutoLISP Reviewer

Ứng dụng được phát triển/Sưu tầm bởi đội ngũ AutoLISP Thật là đơn giản     Thông tin thêm: 👉👉👉