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

https://www.mediafire.com/file/dc2li5t7e7k9c6j/AJS-InsertBlockPlines.lsp/file

Nguồn tham khảo

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-insert-blocks-on-polylines/td-p/9005802

https://www.cadtutor.net/forum/topic/81001-insert-blocks-at-the-vertices-of-the-polyline-and-align-to-the-segments/

---------------------------------------------------------------------------------------------

Ứ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!