Đến nội dung


Hình ảnh
- - - - -

Nhờ Sửa Lisp Matchprop Text Attribute


  • Please log in to reply
2 replies to this topic

#1 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 09 July 2015 - 04:44 PM

Nhờ ae sửa giúp Lisp sau, là khi chọn đối tượng text gốc nó không tự đổi màu mà chỉ sáng (giống select) thôi. Cảm ơn ae!

(defun c:MAT (/ wh txtstring color dt2-1 DT2 txtinput EN)

  (SETQ CMD (GETVAR "CMDECHO"))
  (SETQ OSM (GETVAR "OSMODE"))
  (vl-load-com)
  (SETQ	OLDERR	*error*
	*error*	myerror_cnn
  )
  (setq wh t)
  (Princ
    " Copy and put textstring, working with attribute (even Block, Dim or Exref)."
  )
  (if (setq ThuR_CNN-TxtSave
	     (nentsel
	       "\nSelect TEXT object to get textstring <or Enter>:"
	     )
      )
    (progn
      (setq ThuR_CNN-TxtSave
	     (vlax-ename->vla-object (car ThuR_CNN-TxtSave))
      )
      (setq txtstring (vla-get-textstring ThuR_CNN-TxtSave))
      (setq color 1)
      (if
	(= (setq Thur_CNN-ColorSave (vla-get-color ThuR_CNN-TxtSave))
	   1
	)
	 (setq color 2)
      )
      (vla-put-color ThuR_CNN-TxtSave color)
      (while (or (/= dt2 nil) (/= wh nil))
	(if
	  (setq
	    dt2	(nentsel " \nSelect text object to put textstring:")
	  )
	   (progn (setq dt2 (vlax-ename->vla-object (car dt2)))
		  (vla-put-textstring dt2 txtstring)
	   )
	   (vla-put-color ThuR_CNN-TxtSave ThuR_CNN-ColorSave)
	)
	(setq wh nil)
      )
    )
    (progn
      (setq ThuR_CNN-TxtSave nil)
      (setq
	utility	(vla-get-utility
		  (vla-get-activedocument (vlax-get-acad-object))
		)
      )
      (if (setq
	    txtinput
	     (vla-getstring utility 1 "\nEnter the textstring:")
	  )
	(progn
	  (if (= txtinput "")
	    (princ "\n        Warring: An empty textstring.")
	  )
	  (while (or (/= dt2-1 nil) (/= wh nil))
	    (setq wh nil)
	    (if	(setq
		  dt2-1	(nentsel
			  " \nSelect text object to put textstring :"
			)
		)
	      (progn
		(SETQ EN (CAR DT2-1))
		(setq dt2 (vlax-ename->vla-object (car dt2-1)))
		(if (= txtinput "")
		  (princ "\n          Warring: An empty textstring.")
		)
		(vla-put-textstring dt2 txtinput)
	      )
	    )
	  )
	)
      )					;if2
    )
  )					;if
  (setvar "cmdecho" CMD)		; Restore saved modes
  (setvar "osmode" OSM)
  (setq *error* OLDERR)
  (princ)				; Restore old *error* handler	  
  (princ)
)


  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 09 July 2015 - 05:43 PM

Số lượng topic tăng nhanh nhờ bạn :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 09 July 2015 - 06:01 PM

Số lượng topic tăng nhanh nhờ bạn :)

Hehe, mình không rành về code lắm!


  • 0