Lisp miễn phí thay đổi Annotative nhiều đối tượng | CHGTOCANNOSCALE | 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: 👉👉👉

CHGTOCANNOSCALE

Thay đổi thuộc tính Annotative cho nhiều đối tượng.

1 Thêm class CHGTOCANNOSCALE_.lsp

Lưu mã sau dưới dạng tệp tin CHGTOCANNOSCALE_.lsp

Code:

;;=====================================================================================
;; C:CHGTOCANNOSCALE								11/16/2024 4:46 PM
;;
;; Change selected objects to support current annotation scale only
;;-------------------------------------------------------------------------------------
;; Author:
;;
;; Rick Tolleshaug, TimeSavers for CAD
;; e: rick@timesaversforcad.com
;; w: https://timesaversforcad.com
;;=====================================================================================
(defun c:chgtocannoscale ( / ss i rs# cas ssa e ed ae easl masl )
	(if (setq ss (ssget "_:L" '((0 . "DIMENSION,*TEXT,*LEADER,INSERT,HATCH"))))
		(progn
			(setq cas (getvar "cannoscale")
						ssa (ssadd)
						i (sslength ss)
			)
			(repeat i
				(setq e (ssname ss (setq i (1- i)))
							ed (entget e)
				)
				(if (setq easl (getannoscll ed))					;entity is annotative, put assigned scales into list
					(if (setq ae T													;signals annotative entity selected, for prompt at end
										easl (vl-remove cas easl)			;if entity is assigned more than just current annotative scale
							)
						(progn
							(ssadd e ssa)												;then add entity to sel set
							(foreach as easl										;and add entity's other annotative scales to master list
								(or (member as masl)
										(setq masl (cons as masl))
								)
							)
						)
					)
				)
			)
			(if (> (sslength ssa) 0)
				(progn
					(setvar "cmdecho" 0)
					(command-s "_.UNDO" "_BE")
					(command-s "_.OBJECTSCALE" ss "" "_A" cas "")
					(command "_.OBJECTSCALE" ss "" "_D")
					(foreach as masl (command as))
					(command "")
					(command-s "_.UNDO" "_E")
				)
				(if ae
					(princ "\nNo change occurred for selected annotative objects.")
					(princ "\nNo annotative objects were selected.")
				)
			)
		)
	)
	(princ)
)
;;------------------------------------------------------------------------------------------
;; GETANNOSCLL   Rick Tolleshaug, TimeSavers for CAD
;;
;; Returns list of annotative scales assigned to entity, nil if entity is not annotative
;; Arg: ed - entity data
;;------------------------------------------------------------------------------------------
(defun getannoscll (ed / dic itm annol)
	(if (and(setq dic (cdr (assoc 360 (member '(102 . "{ACAD_XDICTIONARY") ed))))
					(setq dic (cdr (assoc -1 (dictsearch dic "AcDbContextDataManager"))))
					(setq	dic (cdr (assoc -1 (dictsearch dic "ACDB_ANNOTATIONSCALES"))))
			)
		(while (setq itm (dictnext dic (not itm)))
			(setq annol (append annol (list (cdr (assoc 300 (entget (cdr (assoc 340 itm))))))))
		)
	)
)

Thông tin tác giả

Tác giả:

;; Rick Tolleshaug, TimeSavers for CAD
;; e: rick@timesaversforcad.com
;; w: https://timesaversforcad.com

Link tải (MediaFire)

📥 https://www.mediafire.com/

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

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