Đến nội dung


Hình ảnh
* * * - - 2 Bình chọn

Viết Lisp theo yêu cầu


  • Chủ đề bị khóa Chủ đề bị khóa
2780 replies to this topic

#2701 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 26 August 2009 - 09:09 PM

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^^)
  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2702 truongthanh

truongthanh

    biết lệnh text

  • Members
  • PipPipPipPip
  • 275 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 26 August 2009 - 09:48 PM

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!
  • 0

#2703 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 27 August 2009 - 12:52 AM

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.
  • 0

#2704 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 27 August 2009 - 09:14 AM

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.c...es/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
  • 1

#2705 conghoan1003

conghoan1003

    biết vẽ point

  • Members
  • PipPip
  • 99 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 August 2009 - 09:56 AM

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.c...es/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!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2706 truongthanh

truongthanh

    biết lệnh text

  • Members
  • PipPipPipPip
  • 275 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 27 August 2009 - 03:14 PM

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!
  • 0

#2707 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 27 August 2009 - 04:51 PM

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à.
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#2708 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 27 August 2009 - 05:30 PM

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
  • 2

#2709 truongthanh

truongthanh

    biết lệnh text

  • Members
  • PipPipPipPip
  • 275 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 27 August 2009 - 05:59 PM

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!
  • 0

#2710 truongthanh

truongthanh

    biết lệnh text

  • Members
  • PipPipPipPip
  • 275 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 27 August 2009 - 06:05 PM

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!
  • 0

#2711 t031285

t031285

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 27 August 2009 - 09:49 PM

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
  • 0

#2712 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 28 August 2009 - 07:47 AM

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.
  • 1

#2713 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 28 August 2009 - 03:49 PM

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.
  • 1

#2714 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 28 August 2009 - 04:31 PM

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:
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2715 kamezoko

kamezoko

    biết vẽ line

  • Members
  • PipPip
  • 25 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 28 August 2009 - 10:24 PM

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:
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
  • 0

#2716 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 29 August 2009 - 03:02 PM

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.c...pfiles/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
  • 0

#2717 kamezoko

kamezoko

    biết vẽ line

  • Members
  • PipPip
  • 25 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 29 August 2009 - 10:56 PM

đâ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.c...pfiles/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:
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
  • 0

#2718 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 30 August 2009 - 07:56 PM

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.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2719 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 30 August 2009 - 09:41 PM

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
  • 2

#2720 kamezoko

kamezoko

    biết vẽ line

  • Members
  • PipPip
  • 25 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 31 August 2009 - 12:02 AM

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....
  • 0