Viết Lisp theo yêu cầu

Tháng 8 26, 2009

TUE có thể viết giúp mình được ko?viết dùm mình lisp convert text và Mtext từ mã VNI windows sang unicodevà ngược lại ko vậy?cảm ơn bạn rất nhiều!

Không fải cái gì lisp cũng làm được, convert text có lẽ chỉ có VB mới làm được. Mình chưa biết hết các hàm của Lisp nhưng mình nghĩ lisp là ngôn ngữ thuần tuý fục vụ cho cad trong khi hệ thống font và bảng mã là vấn đề của hệ điều hành. Phải một ngôn ngữ lập trình ngoài Cad mới có khả năng làm việc đó.

To Thaistreetz
Có phải bạn nói dòng này :

(mapcar '/ (mapcar '+ (car lst_pt) (cadr lst_pt)) '(2.0 2.0))

Thanks anh Gia_Bach nhe. để đêm nay xem xong trận Arsenal em nghiên cứu thử code này xem thế nào. Em tính mót lại cái code của Bác Hoành mà không tim được. có lẽ đành thử chuyển qua hướng khác vậy. (ngủ thui^^)

Tháng 8 26, 2009

Không fải cái gì lisp cũng làm được, convert text có lẽ chỉ có VB mới làm được. Mình chưa biết hết các hàm của Lisp nhưng mình nghĩ lisp là ngôn ngữ thuần tuý fục vụ cho cad trong khi hệ thống font và bảng mã là vấn đề của hệ điều hành. Phải một ngôn ngữ lập trình ngoài Cad mới có khả năng làm việc đó.

HIX HIX!do mình thấy trên diễn đàn có lisp chuyển từ font TCVN sang font UNICODE nên mình nghỉ chắc các bạn viết được Lisp chuyển từ VNI WINDOWNS sang UNICODE!mong các bạn giúp dùm mình với!

Tháng 8 26, 2009

Mình đang tìm cái lisp cộng, trừ, nhân, chia giữa các phần tử tương ứng của 2 hàng text.
Mình nhớ Bác Hoành đã post nó trong topic này nhưng tìm hoài không ra.

Nếu bạn kg nhớ thì nên nêu lại vấn đề mình muốn để mọi người (có cả bác Hoanh) giúp đỡ bạn. Có thể vấn đề đơn giản thôi nhưng bạn cứ nói chung chung thì người khác khó hiểu lắm.

Tháng 8 27, 2009

Cái này mình biết rồi, mình chỉ đổi lệnh lại để cho tiện sử dụng thôi. Mình cũng chẳng hiểu tại sao không biết lệnh mà lại yêu cầu như thế nửa, mà thiệp test trên cad nào vậy?

Thiep dùng cad2007 giống nhau, Tiếc là mình không đưa ảnh như NATACA được, bạn xem ảnh động sẽ thấy lisp VBU làm việc tại máy Thiep, link sau đây:

http://www.cadviet.com/upfiles/2/vetbun.gif

Ngoài ra ý tưởng 2 của Hoan, Thiep cũng đã test xong:

;;;---------------------------------
;;; LISP vet bun (ver 2.0), COPYRIGHT BY THIEP
;;; FREE FROM CADVIET.COM-----------
(defun GiaoDT (e1 e2 / ob1 ob2 g L n kq)
 (setq	ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2)
g   (vlax-variant-value
      (vla-IntersectWith ob1 ob2 acExtendnone)
    )
 )
 (if (/= (vlax-safearray-get-u-bound g 1) -1)
   (setq L (vlax-safearray->list g))
 )
 (setq n 0)
 (repeat (/ (length L) 3)
   (setq kq
   (append (list (list (nth n L) (nth (+ n 1) L) (nth (+ n 2) L)))
	   kq
   )
   )
   (setq n (+ n 3))
 )
 kq
)
(defun LWP (Lpoint *Model* / PntArr)
 (setq	PntArr (vlax-make-safearray
	 vlax-vbDouble
	 (cons 0 (1- (length Lpoint)))
       )
 )
 (vlax-safearray-fill PntArr Lpoint)
 (vla-AddLightWeightPolyline *Model* PntArr)
)
;;;-----------------------
(defun SS-enlst	(ss / c L)
 (setq c -1)
 (repeat (sslength ss)
   (setq L (cons (ssname ss (setq c (1+ c))) L))
 )
 (reverse L)
)
;;;----------------------
(defun taoRay (ModelS poR1 poR2)
 (vla-Addray
   ModelS
   (vlax-3d-point poR1)
   (vlax-3d-point poR2)
 )
)

				;-----------------------
(defun TextTaluy (model k po h ang / obj)
 (setq	obj (vla-AddText
      *Model*
      (strcat "1:" (rtos k 2 1))
      (vlax-3d-point po)
      h
    )
 )
 (vla-put-Alignment obj acAlignmentTopCenter)
 (vla-put-TextAlignmentPoint obj (vlax-3d-point po))
 (vla-put-Rotation obj ang)
 (vla-put-layer obj "vetbun")
)
;;;---------------------
(defun SAVE_MODE ()
 (command "UCS" "W" "")
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_CECOLOR   (getvar "CECOLOR")
OLD_AUTOSNAP  (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (setvar "cmdecho" 0)
 (setvar "plinegen" 1)

)
(defun RESTORE ()
 (setvar "osmode" OLD_OSMODE)
 (setvar "AUTOSNAP" OLD_AUTOSNAP)
 (setvar "ORTHOMODE" OLD_ORTHOMODE)
 (setvar "CECOLOR" OLD_CECOLOR)
 (setvar "cmdecho" 1)
)
;;;--------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;; -------------------------------
(defun existLinetype (doc LineTypeName / item loaded)
 (vlax-for item (vla-get-linetypes doc)
   (if	(= (strcase (vla-get-name item)) (strcase LineTypeName))
     (setq loaded T)
   )
 )
)
;;;------loadLinetype
(defun loadLinetype (doc LineTypeName FileName)
 (if (and
(not (existLinetype doc LineTypeName))
(vl-catch-all-error-p
  (vl-catch-all-apply
    'vla-load
    (list
      (vla-get-Linetypes doc)
      LineTypeName
      FileName
    )
  )
)
     )
   nil
   T
 )
)
;;;--------------------------
(defun lstvexter (obj / lstp)
 (setq	lstp (vlax-safearray->list
       (vlax-variant-value (vla-get-Coordinates obj))
     )
 )
 (setq n 0)
 (repeat (/ (length lstp) 2)
   (setq kqp
   (cons (list (nth n lstp) (nth (+ n 1) lstp) 0.0)
	 kqp
   )
   )
   (setq n (+ n 2))
 )
 kqp
)
;;;--------------------------
(vl-load-com)

;;;================================MAIN=============================
(DEFUN c:vbu (/	     ActDoc *Model*	  *layer*	en     ss
      p1     Pa	    Pb	   p1	  p11	 p2	p21    p3
      p4     objD   enD	   objR1  objR2	 enR1	enR2   pin1
      pin2   pe1    pe2	   objL2  objL1	 enL1	enL2   lay
      an1    an2    pTex1  pTex2  i	 ss	lop    upp
      un     ofp    intP   enLWP  LenLWP Lllup	LenGH  lstLWp
      Lint   Len    lstp objL2
     )
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
*layer*	(vla-get-Layers ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (SAVE_MODE)
 (setvar "osmode" 0)
 (loadLinetype ActDoc "HIDDEN" "acad.lin")
 (if (not (setq enlay (tblobjname "layer" "vetbun")))
   (progn
     (setq lay (vla-add *layer* "vetbun"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "HIDDEN")
   )
   (progn
     (setq lay (vlax-ename->vla-object enlay))
     (setq lay (vla-add *layer* "vetbun"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "HIDDEN")
   )
 )
 (princ "Chon cac curve be mat nao vet: ")

 (setq SS (ssget '((0 . "LWPOLYLINE,LINE"))))
 (if (null k_Thiep1)
   (setq
     k_Thiep1 (getreal "\nChon goc doc nao vet ben PHAI (mau so): ")
   )
 )
 (if (null k_Thiep2)
   (setq
     k_Thiep2 (getreal "\nChon goc doc nao vet ben TRAI (mau so): ")
   )
 )
 (if (null d_Thiep)
   (setq d_Thiep (getreal "\nChieu sau nao vet: "))
 )
 (if (null hei_Thiep)
   (setq hei_Thiep (getreal "\nChon chieu cao chu: "))
 )
 (setq	Len (SS-enlst ss)
i   0
 )
 (foreach en Len
   (if	(and (eq (dxf 0 en) "LWPOLYLINE")
     (eq (strcase (dxf 8 en)) "DUONGTUNHIEN")
)
     (setq LenLWP (cons en LenLWP))
   )
 )
 (foreach enLWP LenLWP
   (redraw enLWP 3)
   (setq objLW	(vlax-ename->vla-object enLWP)
  Lllup	(ACET-ENT-GEOMEXTENTS enLWP)
  lop	(car Lllup)
  upp	(cadr Lllup)
  un	(getvar "viewsize")
  ofp	(list (/ (+ (car upp) (car lop)) 2)
	      (- (cadr lop) un)
	      0.0
	)
   )
   (setq pA (vlax-curve-getStartPoint enLWP)
  pB (vlax-curve-getEndPoint enLWP)
   )
   (if	(< (car pA) (car pB))
     (progn
(setq flag -0.1)
(setq disoff d_Thiep)
     )
     (progn
(setq flag 0.1)
(setq disoff (- d_Thiep))
     )
   )
   (setq objLW1 (car (vlax-safearray->list
		(vlax-variant-value (vla-offset objLW flag))
	      )
	 )
   )
   (setq lstLWp (lstvexter objLW1)
				;(setq lstP	(ACET-GEOM-VERTEX-LIST enLWP)
  ss	 (ssget "F" lstLWp)
  LenGH	 (SS-enlst ss)
  kqp	 nil
   )
   (vla-delete objLW1)
   (foreach enGH LenGH
     (if (and (eq (DXF 0 enGH) "LINE")
       (setq intP (car (GiaoDT enGH enLWP)))
  )
(progn
  (setq Lint (cons intP Lint))
  (setq kq nil)
)
     )
   )
   (setq Lint
   (vl-sort
     Lint
     '(lambda (e1 e2) (< (car e1) (car e2)))
   )
   )
   (setq p1  (car Lint)
  p2  (cadr Lint)
  p11 (list (+ (car p1) k_Thiep1) (- (cadr p1) 1) 0.0)
  p21 (list (- (car p2) k_Thiep2) (- (cadr p2) 1) 0.0)
  an1 (angle p1 p11)
  an2 (angle p2 p21)
   )
;;;================
   (vla-offset objLW disoff)
   (setq enD (entlast))
   (setq objR1	(taoRay *Model* p1 p11)
  objR2	(taoRay *Model* p2 p21)
   )
   (setq enR1 (vlax-vla-object->ename objR1)
  enR2 (vlax-vla-object->ename objR2)
   )
   (setq PA (vlax-curve-getStartPoint enD)
  PB (vlax-curve-getEndPoint enD)
   )
   (setq pin1 (car (giaoDT enR1 enD))
  p11  (car (giaoDT enR1 enLWP))
  pin2 (car (giaoDT enR2 enD))
  p22  (car (giaoDT enR2 enLWP))
  pinR (car (giaoDT enR1 enR2))
  kq   nil
   )
   (cond ((/= p1 p11)
   (setq p1 p11)
  )
  ((/= p2 p22)
   (setq p2 p22)
  )
   )
   (setvar "osmode" 0)
   (if	(< (car pin1) (car pin2))
     (Progn
(vla-delete objR1)
(vla-delete objR2)
(if (< (car PA) (car PB))
  (progn
    (VL-CMDF "_.break" enD pin2 pin2)
    (setq ss (ssname (ssget pin2) 0))
    (entdel ss)
    (setq pe1 (list (+ (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
	  pe2 (list (+ (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
	  pe3 (list (- (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
	  pe4 (list (- (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
    )
    (setq enD (ssname (ssget pin1) 0))
    (VL-CMDF "_.break" enD pin1 pin1)
    (entdel (ssname (ssget "F" (list pe3 pe4)) 0))
    (setq enD (ssname (ssget "F" (list pe1 pe2)) 0))
  )
  (progn
    (VL-CMDF "_.break" enD pin1 pin1)
    (setq ss (ssname (ssget pin1) 0))
    (entdel ss)
    (setq pe1 (list (+ (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
	  pe2 (list (+ (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
	  pe3 (list (- (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
	  pe4 (list (- (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
    )
    (setq enD (ssname (ssget pin2) 0))
    (VL-CMDF "_.break" enD pin2 pin2)
    (entdel (ssname (ssget "F" (list pe1 pe2)) 0))
    (setq enD (ssname (ssget "F" (list pe3 pe4)) 0))
  )
)
(setq Lp    (list (car p1)
		  (cadr p1)
		  (car pin1)
		  (cadr pin1)
	    )
      objL1 (LWP Lp *Model*)
      enL1  (vlax-vla-object->ename objL1)
)
(setq Lp    (list (car p2)
		  (cadr p2)
		  (car pin2)
		  (cadr pin2)
	    )
      objL2 (LWP Lp *Model*)
      enL2  (vlax-vla-object->ename objL2)
)
(vl-cmdf ".pedit" "m" enL1 end enL2 "" "j" "" "")
(setq lineNV (vlax-ename->vla-object (entlast)))
     )

     (Progn
(vla-delete objR1)
(vla-delete objR2)
(entdel enD)
(setq Lp (list (car p1)
	       (cadr p1)
	       (car pinR)
	       (cadr pinR)
	       (car p2)
	       (cadr p2)
	 )
)
(setq lineNV (LWP Lp *Model*))
(setq pin1 pinR
      pin2 pinR
)
     )

   )

   (vla-put-layer lineNV "vetbun")
   (vla-put-color lineNV acbylayer)
   (vla-put-LinetypeScale lineNV 2)
   (vla-put-LinetypeGeneration lineNV T)

   (setq pTex1	(polar (acet-geom-midpoint p1 pin1)
	       (- an1 (/ pi 2))
	       (/ hei_Thiep 2)
	)
   )
   (TextTaluy *Model* k_Thiep1 pTex1 hei_Thiep an1)
   (setq pTex2	(polar (acet-geom-midpoint p2 pin2)
	       (+ an2 (/ pi 2))
	       (/ hei_Thiep 2)
	)
   )
   (TextTaluy *Model* k_Thiep2 pTex2 hei_Thiep (+ an2 pi))
   (setq Lint	 nil
  Len	 nil
  lstp	 nil
  LenLWP (cdr LenLWP)
   )
 (vla-Regen ActDoc acActiveViewport)
 )

 (vla-ZoomExtents (vlax-get-acad-object))
 (RESTORE)
 (vla-EndUndoMark ActDoc)
 (princ "\nChuc cac ban thanh cong. Thiep")
 (princ)
)
;;;=============================================================================
=================================
;;;-----------------ham dinh thong so k_Thiep, d_Thiep, hei_Thiep
(defun c:khd ()
 (setq	k_Thiep1 (cond (k_Thiep1)
	       (5)
	 )
 )
 (setq oldk_Thiep1 k_Thiep1)
 (setq
   k_Thiep1 (getreal
       (strcat "\nChon goc doc nao vet ben PHAI (mau so) <"
	       (rtos oldk_Thiep1 2 1)
	       "> : "

       )
     )
 )
 (if (null k_Thiep1)
   (setq k_Thiep1 oldk_Thiep1)
 )
 (setq	k_Thiep2 (cond (k_Thiep2)
	       (5)
	 )
 )
 (setq oldk_Thiep2 k_Thiep2)
 (setq
   k_Thiep2 (getreal
       (strcat "\nChon goc doc nao vet ben TRAI (mau so) <"
	       (rtos oldk_Thiep2 2 1)
	       "> : "

       )
     )
 )
 (if (null k_Thiep2)
   (setq k_Thiep2 oldk_Thiep2)
 )



 (setq	d_Thiep	(cond (d_Thiep)
	      (5)
	)
 )
 (setq oldd_Thiep d_Thiep)
 (setq	d_Thiep	(getreal (strcat "\nChieu sau nao vet <"
			 (rtos oldd_Thiep 2 1)
			 "> : "

		 )
	)
 )
 (if (null d_Thiep)
   (setq d_Thiep oldd_Thiep)
 )
 (setq	hei_Thiep (cond	(hei_Thiep)
		(5)
	  )
 )
 (setq oldhei_Thiep hei_Thiep)
 (setq	hei_Thiep (getreal (strcat "\nChon chieu cao chu <"
			   (rtos oldhei_Thiep 2 1)
			   "> : "

		   )
	  )
 )
 (if (null hei_Thiep)
   (setq hei_Thiep oldhei_Thiep)
 )
 (prinC "\nBay gio ban co the su dung lenh VBU")
 (princ)
 (c:vbu)
)

Lisp yêu cầu chọn các mằt cắt địa hình (thuộc lớp DUONGTUNHIEN) và các đường giới hạn (LINE) cùng 1 lúc

Tháng 8 27, 2009

Thiep dùng cad2007 giống nhau, Tiếc là mình không đưa ảnh như NATACA được, bạn xem ảnh động sẽ thấy lisp VBU làm việc tại máy Thiep, link sau đây:

http://www.cadviet.com/upfiles/2/vetbun.gif

Ngoài ra ý tưởng 2 của Hoan, Thiep cũng đã test xong:

;;;---------------------------------
;;; LISP vet bun (ver 2.0), COPYRIGHT BY THIEP
;;; FREE FROM CADVIET.COM-----------
(defun GiaoDT (e1 e2 / ob1 ob2 g L n kq)
 (setq	ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2)
g   (vlax-variant-value
      (vla-IntersectWith ob1 ob2 acExtendnone)
    )
 )
 (if (/= (vlax-safearray-get-u-bound g 1) -1)
   (setq L (vlax-safearray->list g))
 )
 (setq n 0)
 (repeat (/ (length L) 3)
   (setq kq
   (append (list (list (nth n L) (nth (+ n 1) L) (nth (+ n 2) L)))
	   kq
   )
   )
   (setq n (+ n 3))
 )
 kq
)
(defun LWP (Lpoint *Model* / PntArr)
 (setq	PntArr (vlax-make-safearray
	 vlax-vbDouble
	 (cons 0 (1- (length Lpoint)))
       )
 )
 (vlax-safearray-fill PntArr Lpoint)
 (vla-AddLightWeightPolyline *Model* PntArr)
)
;;;-----------------------
(defun SS-enlst	(ss / c L)
 (setq c -1)
 (repeat (sslength ss)
   (setq L (cons (ssname ss (setq c (1+ c))) L))
 )
 (reverse L)
)
;;;----------------------
(defun taoRay (ModelS poR1 poR2)
 (vla-Addray
   ModelS
   (vlax-3d-point poR1)
   (vlax-3d-point poR2)
 )
)

				;-----------------------
(defun TextTaluy (model k po h ang / obj)
 (setq	obj (vla-AddText
      *Model*
      (strcat "1:" (rtos k 2 1))
      (vlax-3d-point po)
      h
    )
 )
 (vla-put-Alignment obj acAlignmentTopCenter)
 (vla-put-TextAlignmentPoint obj (vlax-3d-point po))
 (vla-put-Rotation obj ang)
 (vla-put-layer obj "vetbun")
)
;;;---------------------
(defun SAVE_MODE ()
 (command "UCS" "W" "")
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_CECOLOR   (getvar "CECOLOR")
OLD_AUTOSNAP  (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (setvar "cmdecho" 0)
 (setvar "plinegen" 1)

)
(defun RESTORE ()
 (setvar "osmode" OLD_OSMODE)
 (setvar "AUTOSNAP" OLD_AUTOSNAP)
 (setvar "ORTHOMODE" OLD_ORTHOMODE)
 (setvar "CECOLOR" OLD_CECOLOR)
 (setvar "cmdecho" 1)
)
;;;--------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;; -------------------------------
(defun existLinetype (doc LineTypeName / item loaded)
 (vlax-for item (vla-get-linetypes doc)
   (if	(= (strcase (vla-get-name item)) (strcase LineTypeName))
     (setq loaded T)
   )
 )
)
;;;------loadLinetype
(defun loadLinetype (doc LineTypeName FileName)
 (if (and
(not (existLinetype doc LineTypeName))
(vl-catch-all-error-p
  (vl-catch-all-apply
    'vla-load
    (list
      (vla-get-Linetypes doc)
      LineTypeName
      FileName
    )
  )
)
     )
   nil
   T
 )
)
;;;--------------------------
(defun lstvexter (obj / lstp)
 (setq	lstp (vlax-safearray->list
       (vlax-variant-value (vla-get-Coordinates obj))
     )
 )
 (setq n 0)
 (repeat (/ (length lstp) 2)
   (setq kqp
   (cons (list (nth n lstp) (nth (+ n 1) lstp) 0.0)
	 kqp
   )
   )
   (setq n (+ n 2))
 )
 kqp
)
;;;--------------------------
(vl-load-com)

;;;================================MAIN=============================
(DEFUN c:vbu (/	     ActDoc *Model*	  *layer*	en     ss
      p1     Pa	    Pb	   p1	  p11	 p2	p21    p3
      p4     objD   enD	   objR1  objR2	 enR1	enR2   pin1
      pin2   pe1    pe2	   objL2  objL1	 enL1	enL2   lay
      an1    an2    pTex1  pTex2  i	 ss	lop    upp
      un     ofp    intP   enLWP  LenLWP Lllup	LenGH  lstLWp
      Lint   Len    lstp objL2
     )
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
*layer*	(vla-get-Layers ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (SAVE_MODE)
 (setvar "osmode" 0)
 (loadLinetype ActDoc "HIDDEN" "acad.lin")
 (if (not (setq enlay (tblobjname "layer" "vetbun")))
   (progn
     (setq lay (vla-add *layer* "vetbun"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "HIDDEN")
   )
   (progn
     (setq lay (vlax-ename->vla-object enlay))
     (setq lay (vla-add *layer* "vetbun"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "HIDDEN")
   )
 )
 (princ "Chon cac curve be mat nao vet: ")

 (setq SS (ssget '((0 . "LWPOLYLINE,LINE"))))
 (if (null k_Thiep1)
   (setq
     k_Thiep1 (getreal "\nChon goc doc nao vet ben PHAI (mau so): ")
   )
 )
 (if (null k_Thiep2)
   (setq
     k_Thiep2 (getreal "\nChon goc doc nao vet ben TRAI (mau so): ")
   )
 )
 (if (null d_Thiep)
   (setq d_Thiep (getreal "\nChieu sau nao vet: "))
 )
 (if (null hei_Thiep)
   (setq hei_Thiep (getreal "\nChon chieu cao chu: "))
 )
 (setq	Len (SS-enlst ss)
i   0
 )
 (foreach en Len
   (if	(and (eq (dxf 0 en) "LWPOLYLINE")
     (eq (strcase (dxf 8 en)) "DUONGTUNHIEN")
)
     (setq LenLWP (cons en LenLWP))
   )
 )
 (foreach enLWP LenLWP
   (redraw enLWP 3)
   (setq objLW	(vlax-ename->vla-object enLWP)
  Lllup	(ACET-ENT-GEOMEXTENTS enLWP)
  lop	(car Lllup)
  upp	(cadr Lllup)
  un	(getvar "viewsize")
  ofp	(list (/ (+ (car upp) (car lop)) 2)
	      (- (cadr lop) un)
	      0.0
	)
   )
   (setq pA (vlax-curve-getStartPoint enLWP)
  pB (vlax-curve-getEndPoint enLWP)
   )
   (if	(< (car pA) (car pB))
     (progn
(setq flag -0.1)
(setq disoff d_Thiep)
     )
     (progn
(setq flag 0.1)
(setq disoff (- d_Thiep))
     )
   )
   (setq objLW1 (car (vlax-safearray->list
		(vlax-variant-value (vla-offset objLW flag))
	      )
	 )
   )
   (setq lstLWp (lstvexter objLW1)
				;(setq lstP	(ACET-GEOM-VERTEX-LIST enLWP)
  ss	 (ssget "F" lstLWp)
  LenGH	 (SS-enlst ss)
  kqp	 nil
   )
   (vla-delete objLW1)
   (foreach enGH LenGH
     (if (and (eq (DXF 0 enGH) "LINE")
       (setq intP (car (GiaoDT enGH enLWP)))
  )
(progn
  (setq Lint (cons intP Lint))
  (setq kq nil)
)
     )
   )
   (setq Lint
   (vl-sort
     Lint
     '(lambda (e1 e2) (< (car e1) (car e2)))
   )
   )
   (setq p1  (car Lint)
  p2  (cadr Lint)
  p11 (list (+ (car p1) k_Thiep1) (- (cadr p1) 1) 0.0)
  p21 (list (- (car p2) k_Thiep2) (- (cadr p2) 1) 0.0)
  an1 (angle p1 p11)
  an2 (angle p2 p21)
   )
;;;================
   (vla-offset objLW disoff)
   (setq enD (entlast))
   (setq objR1	(taoRay *Model* p1 p11)
  objR2	(taoRay *Model* p2 p21)
   )
   (setq enR1 (vlax-vla-object->ename objR1)
  enR2 (vlax-vla-object->ename objR2)
   )
   (setq PA (vlax-curve-getStartPoint enD)
  PB (vlax-curve-getEndPoint enD)
   )
   (setq pin1 (car (giaoDT enR1 enD))
  p11  (car (giaoDT enR1 enLWP))
  pin2 (car (giaoDT enR2 enD))
  p22  (car (giaoDT enR2 enLWP))
  pinR (car (giaoDT enR1 enR2))
  kq   nil
   )
   (cond ((/= p1 p11)
   (setq p1 p11)
  )
  ((/= p2 p22)
   (setq p2 p22)
  )
   )
   (setvar "osmode" 0)
   (if	(< (car pin1) (car pin2))
     (Progn
(vla-delete objR1)
(vla-delete objR2)
(if (< (car PA) (car PB))
  (progn
    (VL-CMDF "_.break" enD pin2 pin2)
    (setq ss (ssname (ssget pin2) 0))
    (entdel ss)
    (setq pe1 (list (+ (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
	  pe2 (list (+ (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
	  pe3 (list (- (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
	  pe4 (list (- (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
    )
    (setq enD (ssname (ssget pin1) 0))
    (VL-CMDF "_.break" enD pin1 pin1)
    (entdel (ssname (ssget "F" (list pe3 pe4)) 0))
    (setq enD (ssname (ssget "F" (list pe1 pe2)) 0))
  )
  (progn
    (VL-CMDF "_.break" enD pin1 pin1)
    (setq ss (ssname (ssget pin1) 0))
    (entdel ss)
    (setq pe1 (list (+ (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
	  pe2 (list (+ (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
	  pe3 (list (- (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
	  pe4 (list (- (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
    )
    (setq enD (ssname (ssget pin2) 0))
    (VL-CMDF "_.break" enD pin2 pin2)
    (entdel (ssname (ssget "F" (list pe1 pe2)) 0))
    (setq enD (ssname (ssget "F" (list pe3 pe4)) 0))
  )
)
(setq Lp    (list (car p1)
		  (cadr p1)
		  (car pin1)
		  (cadr pin1)
	    )
      objL1 (LWP Lp *Model*)
      enL1  (vlax-vla-object->ename objL1)
)
(setq Lp    (list (car p2)
		  (cadr p2)
		  (car pin2)
		  (cadr pin2)
	    )
      objL2 (LWP Lp *Model*)
      enL2  (vlax-vla-object->ename objL2)
)
(vl-cmdf ".pedit" "m" enL1 end enL2 "" "j" "" "")
(setq lineNV (vlax-ename->vla-object (entlast)))
     )

     (Progn
(vla-delete objR1)
(vla-delete objR2)
(entdel enD)
(setq Lp (list (car p1)
	       (cadr p1)
	       (car pinR)
	       (cadr pinR)
	       (car p2)
	       (cadr p2)
	 )
)
(setq lineNV (LWP Lp *Model*))
(setq pin1 pinR
      pin2 pinR
)
     )

   )

   (vla-put-layer lineNV "vetbun")
   (vla-put-color lineNV acbylayer)
   (vla-put-LinetypeScale lineNV 2)
   (vla-put-LinetypeGeneration lineNV T)

   (setq pTex1	(polar (acet-geom-midpoint p1 pin1)
	       (- an1 (/ pi 2))
	       (/ hei_Thiep 2)
	)
   )
   (TextTaluy *Model* k_Thiep1 pTex1 hei_Thiep an1)
   (setq pTex2	(polar (acet-geom-midpoint p2 pin2)
	       (+ an2 (/ pi 2))
	       (/ hei_Thiep 2)
	)
   )
   (TextTaluy *Model* k_Thiep2 pTex2 hei_Thiep (+ an2 pi))
   (setq Lint	 nil
  Len	 nil
  lstp	 nil
  LenLWP (cdr LenLWP)
   )
 (vla-Regen ActDoc acActiveViewport)
 )

 (vla-ZoomExtents (vlax-get-acad-object))
 (RESTORE)
 (vla-EndUndoMark ActDoc)
 (princ "\nChuc cac ban thanh cong. Thiep")
 (princ)
)
;;;=============================================================================

=================================
;;;-----------------ham dinh thong so k_Thiep, d_Thiep, hei_Thiep
(defun c:khd ()
 (setq	k_Thiep1 (cond (k_Thiep1)
	       (5)
	 )
 )
 (setq oldk_Thiep1 k_Thiep1)
 (setq
   k_Thiep1 (getreal
       (strcat "\nChon goc doc nao vet ben PHAI (mau so) <"
	       (rtos oldk_Thiep1 2 1)
	       "> : "

       )
     )
 )
 (if (null k_Thiep1)
   (setq k_Thiep1 oldk_Thiep1)
 )
 (setq	k_Thiep2 (cond (k_Thiep2)
	       (5)
	 )
 )
 (setq oldk_Thiep2 k_Thiep2)
 (setq
   k_Thiep2 (getreal
       (strcat "\nChon goc doc nao vet ben TRAI (mau so) <"
	       (rtos oldk_Thiep2 2 1)
	       "> : "

       )
     )
 )
 (if (null k_Thiep2)
   (setq k_Thiep2 oldk_Thiep2)
 )
 (setq	d_Thiep	(cond (d_Thiep)
	      (5)
	)
 )
 (setq oldd_Thiep d_Thiep)
 (setq	d_Thiep	(getreal (strcat "\nChieu sau nao vet <"
			 (rtos oldd_Thiep 2 1)
			 "> : "

		 )
	)
 )
 (if (null d_Thiep)
   (setq d_Thiep oldd_Thiep)
 )
 (setq	hei_Thiep (cond	(hei_Thiep)
		(5)
	  )
 )
 (setq oldhei_Thiep hei_Thiep)
 (setq	hei_Thiep (getreal (strcat "\nChon chieu cao chu <"
			   (rtos oldhei_Thiep 2 1)
			   "> : "

		   )
	  )
 )
 (if (null hei_Thiep)
   (setq hei_Thiep oldhei_Thiep)
 )
 (prinC "\nBay gio ban co the su dung lenh VBU")
 (princ)
 (c:vbu)
)

Lisp yêu cầu chọn các mằt cắt địa hình (thuộc lớp DUONGTUNHIEN) và các đường giới hạn (LINE) cùng 1 lúc

Mình cũng chẳng hiều tại sao mình chạy cái đó bị lỗi nữa nhưng cái ý lisp thứ hai thì chạy tốt lắm, tạm thời mình chưa thấy lỗi nào cả!Rất tiết nút Thank chỉ kích được một lần. Cảm ơn thiêp nhiều nha!

Tháng 8 27, 2009

TUE có thể viết giúp mình được ko?viết dùm mình lisp convert text và Mtext từ mã VNI windows sang unicodevà ngược lại ko vậy?cảm ơn bạn rất nhiều!

Tháng 8 27, 2009

Không fải cái gì lisp cũng làm được, convert text có lẽ chỉ có VB mới làm được.

Thực chất việc này là một chuổi tìm kiếm và thay thế giữa 2 danh sách do người viết lisp viết sẳn thôi bạn ạ. cái này bác Hoành đã viết thành công. Nếu muốn thay đổi font nguồn và font đích thì chỉ cần bác Hoành thêm cái danh sách cho hai mã này là được mà.

Tháng 8 27, 2009

TUE có thể viết giúp mình được ko?viết dùm mình lisp convert text và Mtext từ mã VNI windows sang unicodevà ngược lại ko vậy?cảm ơn bạn rất nhiều!

Tue_NV có thể viết được nhưng rất tiếc là mình không có nhiều thời gian để viết Lisp này vì như anh Duy đã nói là xây dựng 1 danh sách chuyển đổi giữa danh sách nguồn và danh sách đích tốn rất nhiều thời gian cho nên Tue_NV chưa thể hoàn thành Code được. Mong bạn thông cảm

Không fải cái gì lisp cũng làm được, convert text có lẽ chỉ có VB mới làm được. Mình chưa biết hết các hàm của Lisp nhưng mình nghĩ lisp là ngôn ngữ thuần tuý fục vụ cho cad trong khi hệ thống font và bảng mã là vấn đề của hệ điều hành. Phải một ngôn ngữ lập trình ngoài Cad mới có khả năng làm việc đó.

Chào Thaistreetz

Tue_NV xin góp ý với bạn : Mình xin nói thẳng : Bạn nên rút kinh nghiệm : với những chuyện mà ta chưa biết thì chúng ta không nên nói, chúng ta nên yên lặng để tiếp thu những cái mà ta chưa biết để ta học hỏi. Điều đó không có nghĩa là chúng ta giấu những cái ta chưa biết. Mình cũng đã học từ bài học này rất nhiều nay xin góp ý với bạn. Mong bạn hiểu đừng giận

@ : truongthanh , Thaistreetz : Mời 2 bạn xem cái này :

Chuyển đổi font chữ Tiếng Anh thành tiếng Nhật

Tháng 8 27, 2009

Thực chất việc này là một chuổi tìm kiếm và thay thế giữa 2 danh sách do người viết lisp viết sẳn thôi bạn ạ. cái này bác Hoành đã viết thành công. Nếu muốn thay đổi font nguồn và font đích thì chỉ cần bác Hoành thêm cái danh sách cho hai mã này là được mà.

Hix Hix!vậy là phải đợi bác HOÀNH hả?mà dạo này em có thấy bác HOÀNH lên diễn đàn đâu?ko biết còn có cao thủ nào nữa giúp em ko?em xin chân thành cảm ơn!

Tháng 8 27, 2009

Tue_NV có thể viết được nhưng rất tiếc là mình không có nhiều thời gian để viết Lisp này vì như anh Duy đã nói là xây dựng 1 danh sách chuyển đổi giữa danh sách nguồn và danh sách đích tốn rất nhiều thời gian cho nên Tue_NV chưa thể hoàn thành Code được. Mong bạn thông cảm

Vậy TUE_NV có thể viết dùm mình được ko?Mình sẽ đợi TUE_NV!mong TUE_NV giúp dùm!

Tháng 8 27, 2009

Chào moihoclisp

Bạn chạy thử LISP tính ra Xmax, Ymax, Xmin, Ymin của LayOut hiện hành từ đó tính toạ độ trung bình của 2 điểm Max, Min.

(gán toạ độ đó cho biến INSBASE của bản vẽ.)

(defun C:test(/ vl ov ss lst_pt mid)
 (defun boundarySS (ss / lst_max lst_min ll maxpt minpt ur)
   (vl-load-com)
   (setq lst_min (list)
  lst_max (list) )
   (foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (vla-GetBoundingBox ent 'minpt 'maxpt)
     (setq lst_min (cons (vlax-safearray->list minpt) lst_min)
    lst_max (cons (vlax-safearray->list maxpt) lst_max)  )
     )
   (setq ll (list (car (vl-sort (mapcar 'car lst_min) '<))
	   (car (vl-sort (mapcar 'cadr lst_min) '<))
	   )
  ur (list (last (vl-sort (mapcar 'car lst_max) '<))
	   (last (vl-sort (mapcar 'cadr lst_max) '<))
	   )
  )
   (list ll ur)
   )
 ; ham chinh
 (if (setq ss (ssget "_X" (list (cons 410 (getvar "Ctab")))))
   (progn
     (command "undo" "be")
     (setq vl '("osmode"  "cmdecho") ; Sys Var list
    ov (mapcar 'getvar vl))   ; Get Old values
     (mapcar 'setvar vl '(0 0))
     (setq lst_pt (boundarySS ss)
    mid (mapcar '/ (mapcar '+ (car lst_pt) (cadr lst_pt)) '(2.0 2.0))
    )
     (princ (strcat "\n Point_Min  X = " (rtos(car mid)) "; Y = " (rtos(cadr mid))))
     (entmake (list '(0 . "POINT")(cons 10 mid)) )
     ;(setvar "InsBase" mid)
     (mapcar 'setvar vl ov) ; reset Sys Vars
     (command "undo" "e")(princ)
     )
   )
 )

Lisp bạn sử dụng rất hay nhưng bạn có thể sửa lại nó tính tọa độ trung bình 2 điểm max,min của những đối tượng khi chọn chứ không tính hết tất cả trên bản vẽ.Thanks

Tháng 8 28, 2009

Lisp bạn sử dụng rất hay nhưng bạn có thể sửa lại nó tính tọa độ trung bình 2 điểm max,min của những đối tượng khi chọn chứ không tính hết tất cả trên bản vẽ.Thanks

Bạn tìm dòng :

- (if (setq ss (ssget "_X" (list (cons 410 (getvar "Ctab")))))

và thay thế bằng dòng sau :

- (if (setq ss (ssget))

Chúc thành công.

Tháng 8 28, 2009

TUE có thể viết giúp mình được ko?viết dùm mình lisp convert text và Mtext từ mã VNI windows sang unicodevà ngược lại ko vậy?cảm ơn bạn rất nhiều!

Ừ, như Anh Duy nói đúng đó, nó mất nhiều thời gian, mình đã từng viết mã chuyển từ TCVN3 sang VNI rồi, nay để đáp ứng yêu cầu của bạn xin bạn hãy chờ thêm 1 vài ngày nữa nhé, chương trình này đang trong giai đoạn xào nấu bao giờ xong mình sẽ post lên ngay.

Tháng 8 28, 2009

Chào Thaistreetz
Tue_NV xin góp ý với bạn : Mình xin nói thẳng : Bạn nên rút kinh nghiệm : với những chuyện mà ta chưa biết thì chúng ta không nên nói, chúng ta nên yên lặng để tiếp thu những cái mà ta chưa biết để ta học hỏi. Điều đó không có nghĩa là chúng ta giấu những cái ta chưa biết. Mình cũng đã học từ bài học này rất nhiều nay xin góp ý với bạn. Mong bạn hiểu đừng giận

Ồ, đúng là em đã suy nghĩ theo lối mòn. khi nghe đến convert bảng mã là trong đầu em nghĩ ngay đến việc sử dụng clipboard để chuyển đổi giống như những chương trình convert khác. em đã xem cách thức mà lisp convert từ TCVN3 về VNI đã sử dụng, quả thật rất hay và đơn giản mà em không nghĩ ra.

Cảm ơn anh vì đã góp ý. thực ra ở diễn đàn này em cũng đã học được rất nhiều từ những sự góp ý và giúp đỡ của anh :s_big:

Tháng 8 28, 2009

Lệnh là JD (Joint các Điểm).

Chương trình yêu cầu bạn nhập các đối tượng vào (lẫn lộn cả point và text). Chương trình tự phân biệt đâu là point, đâu là tên điểm và đâu là code rồi thực thi như yêu cầu của bạn.

Text không cần trùng điểm chèn với point mà chỉ cần gần point là chương trình nhận biết được.

(defun c:jd ()
 (setq
   ss         (ssget
	 '((-4 . "		   (-4 . "")
	   (-4 . "")
	   (-4 . "")
	   (-4 . "OR>")
	  )
       )
   lstent     (ss2ent ss)

   lsttendiem (mapcar '(lambda	(e)
		  (cons	(cdr (assoc 10 (entget e)))
			(cdr (assoc 1 (entget e)))
		  )
		)
	       (filter lstent "TEXT" "TENDIEM")
       )
   lstcode    (mapcar '(lambda	(e)
		  (cons	(cdr (assoc 10 (entget e)))
			(cdr (assoc 1 (entget e)))
		  )
		)
	       (filter lstent "TEXT" "CODE")
       )
   lstpoint   (mapcar '(lambda (e) (cdr (assoc 10 (entget e))))
	       (filter lstent "POINT" "DIEM")
       )
   lstpoint   (mapcar '(lambda	(p)
		  (cons (timgan p lsttendiem) p)
		)
	       lstpoint
       )
 )
 (foreach pp lstcode
   (setq
     pc       (car pp)
     tendiem (timgan pc lsttendiem)
     code    (cdr pp)
     p       (cdr (assoc tendiem lstpoint))      
     lstc (explode (substr code 2) "-")
   )

   (foreach cc	lstc
     (setq f (assoc cc lstpoint))
     (if f
(progn
  (setq p0 (cdr f))
  (makeline p0 p)
)
     )
   )
 )

 (princ)
)
 (defun timgan	(p lst / dmin ppluu)
   (foreach pp	lst
     (setq d (distance p (car pp)))
     (if (or (not dmin) (> dmin d))
(setq
  dmin d
  ppluu	pp
)
     )
   )
   (cdr ppluu)
 )

(defun filter(lstent otype olayer / kq)
 (foreach pp lstent
    (setq tt (entget pp))
    (if (and
   (member (cons 0 otype) tt)
   (member (cons 8 olayer) tt)
 )
      (setq kq (append kq (list pp)))
    )
 )
 kq
)

(defun pos (sub st / l1 l2 index)
 (setq	index 1
l1    (strlen sub)
l2    (strlen st)
 )
 (while
   (and (<= (+ index l1 -1) l2) (/= sub (substr st index l1)))
    (setq index (1+ index))
 )
 (if (= sub (substr st index l1))
   index
   nil
 )
)

(defun explode (str sep / kq)
 (setq kq nil)
 (while (setq vt (pos sep str))
   (setq
     kq  (append kq (list (substr str 1 (1- vt))))
     str (substr str (1+ vt))
   )
 )
 (setq kq (append kq (list str)))
 kq
)

(defun makeline	(p1 p2)
 (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)

(defun ss2ent(ss / sodt index lstent)
 (setq
   sodt (if ss (sslength ss) 0)	   
   index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
  index (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)

sao em load thì nó báo lổi (cad2004)

Command: _appload ----jd.lsp successfully loaded.

Command: ; error: extra cdrs in dotted pair on input

Command:

sau đó em copy lisp trên theo cách thủ công sang 1 lisp và paste thì nó báo load thành công nhưng ko thưc hiện được

Command: _appload Copy of jd.lsp successfully loaded.

Command:

Command: jd

Select objects: Specify opposite corner: 104 found

104 were filtered out.

Select objects:

Command:

đến đây em ko biết làm gì????hic

Tháng 8 29, 2009

sao em load thì nó báo lổi (cad2004)
Command: _appload ----jd.lsp successfully loaded.

Command: ; error: extra cdrs in dotted pair on input

Command:

sau đó em copy lisp trên theo cách thủ công sang 1 lisp và paste thì nó báo load thành công nhưng ko thưc hiện được

Command: _appload Copy of jd.lsp successfully loaded.

Command:

Command:

Command: jd

Select objects: Specify opposite corner: 104 found

104 were filtered out.

Select objects:

Command:

đến đây em ko biết làm gì????hic

đây là chương trình của bác Hoành, có lẽ đoạn lisp này của bác ấy đã bị ai chọc ngoái vào rồi nên nó không chạy được. Sau khi đọc yêu cầu xong Tomboy down về và chạy thử thì biết rằng mục đích của chương trình này là nối 2 text lại với nhau, nghe ra có vẻ hơi kỹ qoặc không ai lại đi viết lisp để nối text làm chi, nhưng mình thấy nếu bạn nào đã chạy chương trình Alpha của thầy Mùi thì sẽ thấy hiệu quả của đoạn lisp này, bởi vì chương trình của thầy Mùi khi xuất bản vẽ sang Autocad thì các điểm cao độ thầy xuất như thế này các bạn ạ, ví dụ thầy xuất điểm cao độ là 1,45 thì thầy xuất số '1' trước, sau đó thầy xuất dấu '.' và sau cùng là thầy xuất ',45', vì xuất như thế này nhìn điểm độ cao rất đẹp, đứng ngay ngắn chính giữa dấu chấm point, tuy vậy nó có nhược điểm là khi bạn sửa cao độ thì phải sửa cả 2 chữ, số1 và số ,45 và làm cho rất khó chịu khi phải sửa nhiều text cùng 1 lúc. Để khắc phục vấn đề này nên bác Hoành đã viết đoạn mã để joint chữ số đó lại thành 1 chữ thôi, sau khi đọc kỹ chương trình của bác Hoành thì Tomboy có thấy 1 vài điều phức tạp, thứ nhất là bạn phải để phần Nguyên của text cần gộp vào 1 lớp, phần thập phân vào 1 lớp và cái chấm Point vào 1 lớp như là các lớp sau: TEN DIEM, DIEM và CODE, điều nàu làm cho bạn 1 lần nữa phải đau đầu để chuyển các đối tượng rời rạc đó về 1 lớp, chỉ có như thế nó với chạy được thôi, và còn 1 nhược điểm rất lớn nữa là nếu bạn chọn các đối tượng chọn sao cho phải bằng nhau, ví dụ: bạn chọn được 217 cái point thì cũng phải chọn được 217 cái TEN DIEM và 217 cái CODE nữa, nếu không nó sẽ không ghép đúng và sẽ sảy ra trường hợp râu ông nọ cắm cằm bà kia. Còn nếu như bạn dùng lệnh CHT (R14) hay lệnh CH để thay đổi thuộc tính Justify của text thì có thể chương trình của bác chạy không đúng. Để khắc phục tất cả các lỗi trên, và trên cơ sở chương trình của bác Hoàng, Tomboy đã mạo phạm thay đổi 1 tí code trong đó (mong bác Hoành thông cảm nhé, em ko phải múa võ, em thấy mấy đường quyền của bác rồi... thật đáng bậc tiền bối) để cho chương trình có thể truy bắt đa điểm luôn và thuận tiện cho người sử dụng nữa.

link đây: http://www.cadviet.com/upfiles/2/jd.lsp

to bác Hoành: xin bác đọc bài của em, nếu có thay đổi công năng chương trình của bác thì bác cứ phê bình và góp ý em nhé. Tomboy

Tháng 8 29, 2009

đây là chương trình của bác Hoành, có lẽ đoạn lisp này của bác ấy đã bị ai chọc ngoái vào rồi nên nó không chạy được. Sau khi đọc yêu cầu xong Tomboy down về và chạy thử thì biết rằng mục đích của chương trình này là nối 2 text lại với nhau, nghe ra có vẻ hơi kỹ qoặc không ai lại đi viết lisp để nối text làm chi, nhưng mình thấy nếu bạn nào đã chạy chương trình Alpha của thầy Mùi thì sẽ thấy hiệu quả của đoạn lisp này, bởi vì chương trình của thầy Mùi khi xuất bản vẽ sang Autocad thì các điểm cao độ thầy xuất như thế này các bạn ạ, ví dụ thầy xuất điểm cao độ là 1,45 thì thầy xuất số '1' trước, sau đó thầy xuất dấu '.' và sau cùng là thầy xuất ',45', vì xuất như thế này nhìn điểm độ cao rất đẹp, đứng ngay ngắn chính giữa dấu chấm point, tuy vậy nó có nhược điểm là khi bạn sửa cao độ thì phải sửa cả 2 chữ, số1 và số ,45 và làm cho rất khó chịu khi phải sửa nhiều text cùng 1 lúc. Để khắc phục vấn đề này nên bác Hoành đã viết đoạn mã để joint chữ số đó lại thành 1 chữ thôi, sau khi đọc kỹ chương trình của bác Hoành thì Tomboy có thấy 1 vài điều phức tạp, thứ nhất là bạn phải để phần Nguyên của text cần gộp vào 1 lớp, phần thập phân vào 1 lớp và cái chấm Point vào 1 lớp như là các lớp sau: TEN DIEM, DIEM và CODE, điều nàu làm cho bạn 1 lần nữa phải đau đầu để chuyển các đối tượng rời rạc đó về 1 lớp, chỉ có như thế nó với chạy được thôi, và còn 1 nhược điểm rất lớn nữa là nếu bạn chọn các đối tượng chọn sao cho phải bằng nhau, ví dụ: bạn chọn được 217 cái point thì cũng phải chọn được 217 cái TEN DIEM và 217 cái CODE nữa, nếu không nó sẽ không ghép đúng và sẽ sảy ra trường hợp râu ông nọ cắm cằm bà kia. Còn nếu như bạn dùng lệnh CHT (R14) hay lệnh CH để thay đổi thuộc tính Justify của text thì có thể chương trình của bác chạy không đúng. Để khắc phục tất cả các lỗi trên, và trên cơ sở chương trình của bác Hoàng, Tomboy đã mạo phạm thay đổi 1 tí code trong đó (mong bác Hoành thông cảm nhé, em ko phải múa võ, em thấy mấy đường quyền của bác rồi... thật đáng bậc tiền bối) để cho chương trình có thể truy bắt đa điểm luôn và thuận tiện cho người sử dụng nữa.
link đây: http://www.cadviet.com/upfiles/2/jd.lsp

to bác Hoành: xin bác đọc bài của em, nếu có thay đổi công năng chương trình của bác thì bác cứ phê bình và góp ý em nhé. Tomboy

tôi chạy thử lisp của bạn thì nó hiện như sau:

Command: _appload jd.lsp successfully loaded.

Command:

Command: jd

Undo Enter the number of operations to undo or

[Auto/Control/BEgin/End/Mark/Back] <1>: group

Command:

Select objects: Specify opposite corner: 104 found

Select objects:

Undo Enter the number of operations to undo or

[Auto/Control/BEgin/End/Mark/Back] <1>: end

Command: nil

Command:

chọn đối tượng xong là nó ko thực hiện gì hết...

đây la file mẩu của mình :

http://www.cadviet.com/upfiles/2/3.dwg

xin giúp đở.....thank

Tháng 8 30, 2009

Tue_NV có thể viết được nhưng rất tiếc là mình không có nhiều thời gian để viết Lisp này vì như anh Duy đã nói là xây dựng 1 danh sách chuyển đổi giữa danh sách nguồn và danh sách đích tốn rất nhiều thời gian cho nên Tue_NV chưa thể hoàn thành Code được. Mong bạn thông cảm

Hôm nay em có viết hộ 1 lisp cho một người bạn, cậu ta yêu cầu sử dụng Unicode đối với các text mà lisp vẽ ra màn hình. Và em phát hiện ra là lisp hình như không hỗ trợ nhận dạng bảng mã Unicode. Em viết bằng notepad và đã save as với Encoding là UTF-8. Lisp chạy được nhưng hoàn toàn không nhận diện đc các ký tự tiếng việt của bảng mã Unicode.

Như vậy nếu ta có xây dựng được danh sách mã nguồn (Bảng mã Unicode) và mã đích (bảng mã VNI) thì lisp cũng chỉ nhận diện được mã đích nên có lẽ sẽ không thể dùng được cách mà lisp chuyển từ TCVN3 sang VNI đã làm.

Tháng 8 30, 2009

Hôm nay em có viết hộ 1 lisp cho một người bạn, cậu ta yêu cầu sử dụng Unicode đối với các text mà lisp vẽ ra màn hình. Và em phát hiện ra là lisp hình như không hỗ trợ nhận dạng bảng mã Unicode. Em viết bằng notepad và đã save as với Encoding là UTF-8. Lisp chạy được nhưng hoàn toàn không nhận diện đc các ký tự tiếng việt của bảng mã Unicode.

Như vậy nếu ta có xây dựng được danh sách mã nguồn (Bảng mã Unicode) và mã đích (bảng mã VNI) thì lisp cũng chỉ nhận diện được mã đích nên có lẽ sẽ không thể dùng được cách mà lisp chuyển từ TCVN3 sang VNI đã làm.

Chào Thaistreetz'

Điều bạn nói chỉ là phỏng đoán, chưa hề có cơ sở chắc chắn. Vì bản thân Tue_NV cũng đang xây dựng Code này và thấy rằng các kí tự mình làm chạy rất tốt. Code này hoàn thành rất lâu vì phải xây dựng danh sách nguồn và danh sách đích

Dạo này công việc của Tue_NV rất bận nên có hoàn thành code này trễ thì cũng mong các bạn thông cảm

Không biết các kí tự sau thế nào nhưng các kí tự đầu chạy rất tốt. Hy vọng là mình xây dựng Code thành công để giúp cho mọi người. Mong các bạn ủng hộ. Thanks

Tháng 8 30, 2009

Lệnh là JD (Joint các Điểm).

Chương trình yêu cầu bạn nhập các đối tượng vào (lẫn lộn cả point và text). Chương trình tự phân biệt đâu là point, đâu là tên điểm và đâu là code rồi thực thi như yêu cầu của bạn.

Text không cần trùng điểm chèn với point mà chỉ cần gần point là chương trình nhận biết được.

(defun c:jd ()
 (setq
   ss         (ssget
	 '((-4 . "<OR")
	   (-4 . "<AND")(0 . "POINT") (8 . "DIEM")(-4 . "AND>")
	   (-4 . "<AND")(0 . "TEXT") (8 . "TENDIEM")(-4 . "AND>")
	   (-4 . "<AND")(0 . "TEXT") (8 . "CODE")(-4 . "AND>")
	   (-4 . "OR>")
	  )
       )
   lstent     (ss2ent ss)

   lsttendiem (mapcar '(lambda	(e)
		  (cons	(cdr (assoc 10 (entget e)))
			(cdr (assoc 1 (entget e)))
		  )
		)
	       (filter lstent "TEXT" "TENDIEM")
       )
   lstcode    (mapcar '(lambda	(e)
		  (cons	(cdr (assoc 10 (entget e)))
			(cdr (assoc 1 (entget e)))
		  )
		)
	       (filter lstent "TEXT" "CODE")
       )
   lstpoint   (mapcar '(lambda (e) (cdr (assoc 10 (entget e))))
	       (filter lstent "POINT" "DIEM")
       )
   lstpoint   (mapcar '(lambda	(p)
		  (cons (timgan p lsttendiem) p)
		)
	       lstpoint
       )
 )
 (foreach pp lstcode
   (setq
     pc       (car pp)
     tendiem (timgan pc lsttendiem)
     code    (cdr pp)
     p       (cdr (assoc tendiem lstpoint))      
     lstc (explode (substr code 2) "-")
   )

   (foreach cc	lstc
     (setq f (assoc cc lstpoint))
     (if f
(progn
  (setq p0 (cdr f))
  (makeline p0 p)
)
     )
   )
 )

 (princ)
)
 (defun timgan	(p lst / dmin ppluu)
   (foreach pp	lst
     (setq d (distance p (car pp)))
     (if (or (not dmin) (> dmin d))
(setq
  dmin d
  ppluu	pp
)
     )
   )
   (cdr ppluu)
 )

(defun filter(lstent otype olayer / kq)
 (foreach pp lstent
    (setq tt (entget pp))
    (if (and
   (member (cons 0 otype) tt)
   (member (cons 8 olayer) tt)
 )
      (setq kq (append kq (list pp)))
    )
 )
 kq
)

(defun pos (sub st / l1 l2 index)
 (setq	index 1
l1    (strlen sub)
l2    (strlen st)
 )
 (while
   (and (<= (+ index l1 -1) l2) (/= sub (substr st index l1)))
    (setq index (1+ index))
 )
 (if (= sub (substr st index l1))
   index
   nil
 )
)

(defun explode (str sep / kq)
 (setq kq nil)
 (while (setq vt (pos sep str))
   (setq
     kq  (append kq (list (substr str 1 (1- vt))))
     str (substr str (1+ vt))
   )
 )
 (setq kq (append kq (list str)))
 kq
)

(defun makeline	(p1 p2)
 (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)

(defun ss2ent(ss / sodt index lstent)
 (setq
   sodt (if ss (sslength ss) 0)	   
   index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
  index (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)

có bạn nào biết tại sao lisp trên ko load được vào cad ko? giúp mình với....mình rất cần lisp này.....anh Hoành,anh Tue_NV,ssq...coi dùm em....

Tháng 8 30, 2009

có bạn nào biết tại sao lisp trên ko load được vào cad ko? giúp mình với....mình rất cần lisp này.....anh Hoành,anh Tue_NV,ssq...coi dùm em....

Lisp này làm gì vậy bạn. Mình down về load trên cad2002 nó vẫn bình thường. Gõ lệnh jd kg thấy xảy ra hiện tượng báo lỗi

Tháng 8 31, 2009

Lisp này làm gì vậy bạn. Mình down về load trên cad2002 nó vẫn bình thường. Gõ lệnh jd kg thấy xảy ra hiện tượng báo lỗi

load thì đươc nhưng nó ko chạy gi hết...mình ko biết tại sao lại như vậy...bạn nào biết chỉ dùm..cám ơn :s_big:

Tháng 8 31, 2009

Ừ, như Anh Duy nói đúng đó, nó mất nhiều thời gian, mình đã từng viết mã chuyển từ TCVN3 sang VNI rồi, nay để đáp ứng yêu cầu của bạn xin bạn hãy chờ thêm 1 vài ngày nữa nhé, chương trình này đang trong giai đoạn xào nấu bao giờ xong mình sẽ post lên ngay.

Vô cùng cảm ơn bạn!đợi tin của bạn!tick thanks cho bạn 1 cái đã!

Tháng 8 31, 2009

Chào Thaistreetz'
Điều bạn nói chỉ là phỏng đoán, chưa hề có cơ sở chắc chắn. Vì bản thân Tue_NV cũng đang xây dựng Code này và thấy rằng các kí tự mình làm chạy rất tốt. Code này hoàn thành rất lâu vì phải xây dựng danh sách nguồn và danh sách đích

Dạo này công việc của Tue_NV rất bận nên có hoàn thành code này trễ thì cũng mong các bạn thông cảm

Không biết các kí tự sau thế nào nhưng các kí tự đầu chạy rất tốt. Hy vọng là mình xây dựng Code thành công để giúp cho mọi người. Mong các bạn ủng hộ. Thanks

cảm ơn TUE_NV rất nhiều!hy vọng sẽ sớm được sữ dụng LISP này của TUE!chúc bạn công tác tốt!

Tháng 8 31, 2009

Mình thấy ở đây có khá nhiều bạn quan tâm đến lisp.
Mời các bạn tích cực tham gia đóng góp xây dựng bảng "Nội dung và cấu trúc chương trình" của CadViet Utility.

Xin lisp sắp xếp text theo chiều ngang:

Trước khi thực hiện lệnh

http://www.cadviet.com/upfiles/2/truoc_1.jpg

Sau khi thực hiện lệnh

http://www.cadviet.com/upfiles/2/sau_2.jpg

Xin cảm ơn mọi người rât nhiều.

Đăng nhập

Viết Lisp theo yêu cầu

Các bài được khuyến nghị

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

TRUNGNGAMY 91

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thiep 365

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

conghoan1003 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duy782006 1.517

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

t031285 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.548

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tomboy 21

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

kamezoko 3

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tomboy 21

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

kamezoko 3

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

kamezoko 3