Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

Viết lisp theo yêu cầu [phần 2]

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

Của bạn :

(defun c:kc (/ kc ent A) 
(vl-load-com)
(setq kc (rtos (distance (setq A (getpoint "\nDiem A :"))(getpoint A "\nDiem B :")) 2 2))
(if (setq ent (car(entsel "\n Chon text sua :")))
(vla-put-TextString (vlax-ename->vla-object ent) kc)
(vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) kc	
(vlax-3d-point  (getpoint "\n Diem dat text :"))  (* (getvar "dimtxt")(getvar "dimscale")))
))

bác ơi em làm như hướng dẫn đến chỗ chọn điểm đặt text và em kick vào 1 điểm bất kì nó báo là " Diem dat text :#<VLA-OBJECT IAcadText2 3cefc134> "

thế là bị lỗi gì hả bác.

và cho em hỏi tí :

trong no va em vẽ trắc dọc cao 200 dài 1000 thế thì làm sao đo the tỷ lệ này dc bác nhỉ

 

 

thank bác nhiều

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

bác ơi em làm như hướng dẫn đến chỗ chọn điểm đặt text và em kick vào 1 điểm bất kì nó báo là " Diem dat text :#<VLA-OBJECT IAcadText2 3cefc134> "

thế là bị lỗi gì hả bác.

và cho em hỏi tí :

trong no va em vẽ trắc dọc cao 200 dài 1000 thế thì làm sao đo the tỷ lệ này dc bác nhỉ

 

 

thank bác nhiều

Đỏ : chẳng bị lỗi gì cả. Việc bạn cần là ghi ra khoảng cách, nó làm được rồi thì quan tâm gì đến nó chi :). Còn bạn thích không có dòng đấy thì thêm dòng (princ) vào trước dấu ngoặc cuối cùng.

Xanh : không thể hiểu nổi bạn nói gì

Tím : bạn nhấn Thank là được rồi.

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

có bác nào biết hoặc có lisp stretch block

nhưng chéo lên trên không

hôm trước em có lấy trên diễn đàn

mà giờ cần dùng tìm không thấy

bác nào co cho lai hoặc cho duwòng dẫn em cám ơn nhiều

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

có bác nào biết hoặc có lisp stretch block

nhưng chéo lên trên không

hôm trước em có lấy trên diễn đàn

mà giờ cần dùng tìm không thấy

bác nào co cho lai hoặc cho duwòng dẫn em cám ơn nhiều

Bạn dùng thử cái này. Bài số #1719: http://www.cadviet.com/forum/index.php?showtopic=13203&st=1700

BS: Bạn dùng code ở bài #1756 thì không bị lỗi nhé.

  • Vote tăng 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

Theo mình nghĩ là khó !

kiêu như lệnh scale ấy bác, hay nhiêu lệnh khác cũng thế mà

hay có bác nào viết hộ cho em líp liên quan đến lệnh move ko thôi cũng đc

viết lisp kiểu nào mà nó move giông bằng khoảng cách của lệnh move trước đó

cảm ơn các bác nhiều

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

kiêu như lệnh scale ấy bác, hay nhiêu lệnh khác cũng thế mà

hay có bác nào viết hộ cho em líp liên quan đến lệnh move ko thôi cũng đc

viết lisp kiểu nào mà nó move giông bằng khoảng cách của lệnh move trước đó

cảm ơn các bác nhiều

Khó mà giống thao tác lệnh move bình thường được :

(defun c:m ()
(if (not var) (setq var 100))
(setq tmp (getreal (strcat "Khoang cach move < "(rtos var 2 0) " > :")))
(if tmp (setq var tmp))
(command ".move" (ssget) "" "D" (polar '(0.0 0.0 0.0)(getangle "\nGoc move :" ) var))(princ))

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

kiêu như lệnh scale ấy bác, hay nhiêu lệnh khác cũng thế mà

hay có bác nào viết hộ cho em líp liên quan đến lệnh move ko thôi cũng đc

viết lisp kiểu nào mà nó move giông bằng khoảng cách của lệnh move trước đó

cảm ơn các bác nhiều

Thử cái này xem. Lệnh MD

(defun lenhDM () 
(setq diemgocmovedattendaidekhoitrung (getpoint "\nDiem co so: "))
(setq diemdenmovedattendaidekhoitrung (getpoint diemgocmovedattendaidekhoitrung"\nDiem den: "))
(Princ)) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:MD () 
(Prompt "\nChon cac doi tuong muon move")
(Setq doituongmove (Ssget))
(cond 
     ((= diemgocmovedattendaidekhoitrung nil) (lenhDM))
     ((/= diemgocmovedattendaidekhoitrung nil))
)
(command ".move" doituongmove "" diemgocmovedattendaidekhoitrung diemdenmovedattendaidekhoitrung)
(Princ)) 

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

Thử cái này xem. Lệnh MD

(defun lenhDM () 
(setq diemgocmovedattendaidekhoitrung (getpoint "\nDiem co so: "))
(setq diemdenmovedattendaidekhoitrung (getpoint diemgocmovedattendaidekhoitrung"\nDiem den: "))
(Princ)) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:MD () 
(Prompt "\nChon cac doi tuong muon move")
(Setq doituongmove (Ssget))
(cond 
     ((= diemgocmovedattendaidekhoitrung nil) (lenhDM))
     ((/= diemgocmovedattendaidekhoitrung nil))
)
(command ".move" doituongmove "" diemgocmovedattendaidekhoitrung diemdenmovedattendaidekhoitrung)
(Princ)) 

pro ơi thôi pro trót viết move thì viết nốt copy,rotare và scale đi

thanh pro

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

Thử cái này xem. Lệnh MD

(defun lenhDM () 
(setq diemgocmovedattendaidekhoitrung (getpoint "\nDiem co so: "))
(setq diemdenmovedattendaidekhoitrung (getpoint diemgocmovedattendaidekhoitrung"\nDiem den: "))
(Princ)) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:MD () 
(Prompt "\nChon cac doi tuong muon move")
(Setq doituongmove (Ssget))
(cond 
     ((= diemgocmovedattendaidekhoitrung nil) (lenhDM))
     ((/= diemgocmovedattendaidekhoitrung nil))
)
(command ".move" doituongmove "" diemgocmovedattendaidekhoitrung diemdenmovedattendaidekhoitrung)
(Princ)) 

Lisp này.. lại quá đà. Ôm luôn cả Khoảng cách và Hướng luôn bác DUy ơi ??

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

Lisp này.. lại quá đà. Ôm luôn cả Khoảng cách và Hướng luôn bác DUy ơi ??

Mình đoán ý yêu cầu thế mà. Có điều post lên mới thấy chưa có cho đặt lại 2 điểm. Sẽ sửa lại chút.

pro ơi thôi pro trót viết move thì viết nốt copy,rotare và scale đi

thanh pro

Scale, Rotate vốn đã tự lưu rồi.

 

*Sửa lại rồi đây. Nếu đã tồn tại 2 điểm chuẩn thì hỏi dùng lại hai điểm cũ nhé ừ thì enter ưng đổi thì gỏ D enter nó sẽ cho nhập lại hai điểm.

(defun lenhDM () 
(setq diemgocmovedattendaidekhoitrung (getpoint "\nDiem co so: "))
(setq diemdenmovedattendaidekhoitrung (getpoint diemgocmovedattendaidekhoitrung"\nDiem den: "))
(Princ)) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:MD () 
(Prompt "\nChon cac doi tuong muon move")
(Setq doituongmove (Ssget))
(cond 
     ((= diemgocmovedattendaidekhoitrung nil) (lenhDM))
     ((/= diemgocmovedattendaidekhoitrung nil) (setq candatlaihaidiemhaykhong (strcase (getstring "\nDung lai hai diem cu nhe: Dat lai/<Ok>")))
    (cond 
     ((/= candatlaihaidiemhaykhong "D"))
     ((= candatlaihaidiemhaykhong "D") (lenhDM))
    )
)
)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".move" doituongmove "" diemgocmovedattendaidekhoitrung diemdenmovedattendaidekhoitrung)
(setvar "osmode"luubatdiem)
(Princ)) 

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

Em đang cần một lisp tính diện tích của phần đã được hatch, mong các anh chị trong diễn đàn viết giùm e. e xin cảm ơn

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

Nhờ các Bác chỉnh hộ em đoạn lisp sau: Em không biết tắt Menu 01 khi hiển thị menu 02...

tất cả các Files em gưi theo đường linh: http://www.mediafire.com/myfiles.php

Em xin cám ơn trước.

;-----------------------------------------------------------
(defun SC_DWG (/ AM)
 (setq AM (ATOF (GET_TILE "scale")))
 (setq AMO AM)
)
;-----------------------------------------------------------
(defun GE_DWG (/ GE)
 (setq GE (GET_TILE "gesd"))
 (setq GEO GE)

 (cond
   ((= GEO "1") (MODE_TILE "ges" 0))
   (T (MODE_TILE "ges" 1))
 )
)
;-----------------------------------------------------------
(defun IS_DWG (/ ARE_STE) 
 (setq ARE_STE "island")
 (setq ARE_STEO ARE_STE)
)
;-----------------------------------------------------------
(defun NO_DWG (/ ARE_STE)
 (setq ARE_STE "nomal")
 (setq ARE_STEO ARE_STE)
)  
;-----------------------------------------------------------
(defun OT_DWG (/ ARE_STE)
 (setq ARE_STE "outer")
 (setq ARE_STEO ARE_STE)
)
;-----------------------------------------------------------
(defun PR_FIL (/ PRI_FIL)
 (setq PRI_FIL (GET_TILE "exp"))
 (setq PRI_FILO PRI_FIL)
 (cond
   ((= PRI_FILO "1") (MODE_TILE "fn" 0) (MODE_TILE "pn" 1))
   (T (MODE_TILE "fn" 1) (MODE_TILE "pn" 0))
 )
)
;-----------------------------------------------------------
(defun SE_FIL ()
 (MODE_TILE "del" 0)
 (setq ITEM (ATOI (GET_TILE "dientich")))
)  
;-----------------------------------------------------------
(defun DE_FIL ()
 (REMOVELIST)
)  
;-----------------------------------------------------------
(defun PR_DWG (/ PRI_STE)
 (setq PRI_STE (GET_TILE "print"))
 (setq PRI_STEO PRI_STE)
 (cond
   ((= PRI_STEO "1")
    (MODE_TILE "sodt" 0)
    (MODE_TILE "xuat" 0))
   (T 
    (MODE_TILE "sodt" 1)
    (MODE_TILE "xuat" 1))
 )
)  
;-----------------------------------------------------------
(defun SO_DWG (/ NUMS) 
 (setq NUMS (ATOF (GET_TILE "sodt")))
 (setq NUMSO NUMS)
 (setq TRUNGNHAU 0)
 (alert (rtos NUMSO))

 (setq DCL_AREA (LOAD_DIALOG (strcat "muare" (rtos NUMSO 2 0) ".dcl")))
 (if (not (new_dialog (strcat "muare" (rtos NUMSO 2 0)) DCL_AREA))
  (progn (Restore) (exit))
 )
 (ACTION_TILE "cancel" "(unload_dialog dcl_area)")
 (START_DIALOG)
 (UNLOAD_DIALOG DCL_AREA)
)
;-----------------------------------------------------------
(defun Restore()
 (setvar "BLIPMODE" Oldblp)
 (setvar "CMDECHO" Oldech)
 (setvar "PICKBOX" Oldpbx)
 (setq *ERROR* Olderr)
)
;-----------------------------------------------------------
(defun C:Do-AS()

 (setq DCL_AREA (LOAD_DIALOG "muare0.dcl"))
 (if (not (new_dialog "muare0" DCL_AREA))
  (progn (Restore) (exit))
 )
 (SET_TILE "nomal" "1")
 (SET_TILE "island" "0")
 (SET_TILE "outer" "0")
 (SET_TILE "scale" "1000")

 (MODE_TILE "pick_bound" 1)
 (MODE_TILE "fn" 1)
 (MODE_TILE "ges" 1)
 (MODE_TILE "sodt" 1)

 (ACTION_TILE "scale" "(SC_DWG)")
 (ACTION_TILE "gesd" "(GE_DWG)")
 (ACTION_TILE "nomal" "(NO_DWG)")
 (ACTION_TILE "island" "(IS_DWG)")
 (ACTION_TILE "outer" "(OT_DWG)")
 (ACTION_TILE "pick_bound" "(PI_DWG)")
 (ACTION_TILE "exp" "(PR_FIL)")
 (ACTION_TILE "fn" "(NA_FIL)")
 (ACTION_TILE "dientich" "(SE_FIL)")
 (ACTION_TILE "del" "(DE_FIL)")
 (ACTION_TILE "print" "(PR_DWG)")
 (ACTION_TILE "sodt" "(SO_DWG)");;;;;;;;;;;;;;;;;;;;;;; (done_dialog)")
 (ACTION_TILE "cancel" "(unload_dialog dcl_area)")
 (START_DIALOG)
 (UNLOAD_DIALOG DCL_AREA)
)

Chỉnh sửa theo ketxu
Nhắc lenhatanh cho code vào trong thẻ code

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

Nhờ các Bác chỉnh hộ em đoạn lisp sau: Em không biết tắt Menu 01 khi hiển thị menu 02...

tất cả các Files em gưi theo đường linh: http://www.mediafire.com/myfiles.php

Em xin cám ơn trước.

 

Hề hề hề, cái đường link bạn gửi nó dẫn tớ về tới nhà mình, hề hề hề.

Bạn gửi lại đường link khác nhé...

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

Em đang cần một lisp tính diện tích của phần đã được hatch, mong các anh chị trong diễn đàn viết giùm e. e xin cảm ơn

Hề hề hề,

bạn chịu khó đọc tham khảo các bài phía trên nhé. Có ích cho bạn đấy...

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

Hề hề hề,

Vậy là mình thành trâu chậm rồi. Các bác khác nhanh tay hơn. Dù sao đã trót thì phải trét nên mình cứ post cái mình đã làm để bạn xài thử và cho ý kiến nhé.

 

Với lisp này bạn tùy ý chọn vị trí đặt text sao cho đẹp cái ý của bạn.

Hề hề hề,....

Nếu bạn muốn gộp hai text trên thành một text thì bạn làm như sau:

Thay đoạn code:

(command "TEXT" p1 2 0 ten )

(setq p2 (getpoint "\n Chon diem dat dien tich vung"))

(command "TEXT" p2 2 0 (strcat (rtos dtch 2 6) " M2" ))

thành dòng code sau:

(command "TEXT" p1 2 0 (strcat ten ": " (rtos dtch 2 6) " M2"))

Chúc bạn vui

 

Cảm ơn bạn, đây thực sự là cái mình cần. Cảm ơn rất nhiều

 

 

Nhờ bạn kiểm tra lại xem, sao đôi lúc tính đúng, nhưng đôi lúc tính ko đúng (hình như diện tích bị giảm gần 1 nửa. Với lại chỉ cần 2 con số lẻ thôi và cho cỡ chữ lớn lên khoảng 10 lần dc ko

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

Nhờ các bạn giúp mình 1 lenh lisp chuyển tất cả các đừơng thanh đường 3d với độ cao z giữ nguyên

Mình chỉ cần chuyển định dạng thôi

Mình cũng đã thử lisp 2d3d của bac Tue, nhưng mà ko được

Cám ơn trước

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

có pro nào có lisp vẽ cửa đẹp và chi tiết một chút

mình lấy lisp trong lisp co ban dành cho kiến trúc thì đơn giản và xấu quá

trước mình có thấy 1 lisp đẹp đẹp nhưng ngày đó chưa biết dùng

nay bác nào có share lại hoặc cho đường link cũng được

thank you

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

E có nhờ viết 1 lisp lâu rồi không thấy ai giúp.Giờ mong các bác bớt thời gian viết giúp e.Nội dung tại trang này:

http://www.cadviet.com/forum/index.php?showtopic=13203&st=3540

Lisp này nói thì dễ nhưng lại chẳng dễ chút nào. Bạn chỉ cho ví dụ 2 block có 1 thuộc tính, mình cũng chẳng mường tượng được luôn

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

Nhờ các bạn giúp mình 1 lenh lisp chuyển tất cả các đừơng thanh đường 3d với độ cao z giữ nguyên

Mình chỉ cần chuyển định dạng thôi

Mình cũng đã thử lisp 2d3d của bac Tue, nhưng mà ko được

Cám ơn trước

Hề hề hề,

Bạn hãy gửi bản vẽ mẫu lên nhé, trên đó thể hiện các đường ban đầu bạn có và các đường bạn muốn có sau khi chạy lisp.

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

Lại vấp chỗ add text rồi, hem bít sao nữa :( bạn thử dùng thằng này thay thế xem sao. Chú ý : tạo text theo style + height hiện thời, bạn nên chọn style trước nhé

(defun c:tkh (/ lst msp pt ss lay ar txtsiz pt)
;(mapcar '(lambda(x) (set x nil)) '(lst msp pt ss lay ar txtsiz pt))
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1)
 (progn
 (vl-load-com)
 (acet-sysvar-set (list "cmdecho" 0))
 (grtext -1 "S\U+01A1n T\U+00F9ng' Lisp")
 (Princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Hatch \U+0111\U+1EC3 t\U+00EDnh di\U+1EC7n t\U+00EDch :  ")
 (if (setq ss (ssget(list (cons 0 "HATCH"))))
   (progn
     (foreach e (mapcar 'vlax-ename->vla-object (st-ss->ent ss))
	(setq lay (vlax-get-property e 'Layer)) 
       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list e))))
(setq ar (*  0.000001 (vlax-get-property e 'Area)))
(progn
(setq ar 0)(princ (strcat "\nC\U+00F3 Hatch thu\U+1ED9c layer " lay " kh\U+00F4ng t\U+00EDnh \U+0111\U+01B0\U+1EE3c di\U+1EC7n t\U+00EDch.\n\U+0110\U+00E3 highlight v\U+00E0 t\U+00EDnh di\U+1EC7n t\U+00EDch b\U+1EB1ng 0"))
(redraw (vlax-vla-object->ename e) 3)
)
)
       (if (not (assoc lay lst))
         (setq lst (cons (cons lay ar) lst))
         (setq lst (subst (cons lay (+ ar (cdr (assoc lay lst))))
                          (assoc lay lst) lst))))
     (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))

           txtsiz (* (getvar "dimtxt")(getvar "dimscale"))
           msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) i -1)

     (while (setq e (nth (setq i (1+ i)) lst)) 
       (wtxt_l (strcat (car e) " : " (rtos (cdr e) 2 2) "m2") '(0 0 0))
(setq pt (ACET-SS-DRAG-MOVE (ssadd (entlast)) '(0 0 0) (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t ghi ch\U+00FA t\U+1ED5ng di\U+1EC7n t\U+00EDch Hatch thu\U+1ED9c layer " (car e))))
(command ".move" (entlast) "" '(0 0 0) pt)
)
(princ "\n\U+0110\U+00E3 th\U+1EF1c hi\U+1EC7n xong !")
)
   (alert "Kh\U+00F4ng c\U+00F3 Hatch n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn !"))
)
(alert "Phi\U+00EAn b\U+1EA3n CAD c\U+1EE7a b\U+1EA1n kh\U+00F4ng h\U+1ED7 tr\U+1EE3 t\U+00EDnh di\U+1EC7n t\U+00EDch Hatch !")
)
 (acet-sysvar-restore)(princ))
 (defun st-ss->ent (ss / n e l)
 (setq n -1)
 (while (setq e (ssname ss (setq n (1+ n))))
   (setq l (cons e l))
 )
)
(defun wtxt_l(txt p / sty d h1 h2 wf h);;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")
d (tblsearch "style" sty)
h1 (cdr (assoc 40 d))
h2 (cdr (assoc 42 d))
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))

mình dùng thử đã ổn rồi pro à

chắc có khi cùng lỗi với bạn ở trên

thank you

pro có thể viết thêm cùng loại hatch thì tính 1 diện tích ( về file lớn như quy hoạch có thể dùng rất tốt)

chứ chọn lần lượt từng ô về cơ bản không khác lisp DT là mấy

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

Em tìm được cái Lisp nối Line đã bị break thành 2 đoạn rời nhau, nhưng nó chỉ nối được với Line,

còn Polyline thì không được

Nhờ mấy anh sửa cho nối được với Polyline

 

(defun C:lJ (/ ob1 ob2 ob3 ent1 ent2 ent3 s1 e1 l1 s2 e2 l2 
p1 p2 p3 p4 p5 ang1 ang2 loop lineerr test mloop)
(graphscr)
(defun lineerr(err)
(if (and (/= err "Function cancelled")(/= err "quit / exit abort"))
(progn
(princ (strcat "\n>>Error: " err))
(princ)
)
(princ)
)
(if (and ob1 (/= ob1 "Exit"))(redraw (car ob1) 4))
(if (and ob2 (/= ob2 "Exit"))(redraw (car ob2) 4))
(command "_.UNDO" "_End")
(setvar "cmdecho" 1)
(setq *error* olderr)
)
(setvar "cmdecho" 0)
(setq olderr *error*
*error* lineerr
mloop T
);** setq end **
(command "_.UNDO" "_Group")
(while mloop
(setq loop T)
(while loop
(initget "Exit")
(setq ob1 (entsel "\n>>> Select the first Line or [Exit]: "))
(cond
((= ob1 "Exit")(exit))
((= ob1 nil)(princ "None found."))
((progn
(setq test (cdr (assoc 0 (entget (car ob1)))))
(if (/= test "LINE")(princ "This is not a Line")(setq loop nil))
))
)
);** while end **
(setq ent1 (entget (car ob1))
loop T
test nil
);** setq end **
(redraw (car ob1) 3)
(while loop
(initget "Exit")
(setq ob2 (entsel "\n>>> Select the second Line or [Exit]: "))
(cond
((= ob2 "Exit")(exit))
((= ob2 nil)(princ "None found."))
((eq (car ob1) (car ob2))(princ "Duplicated select"))
((progn
(setq test (cdr (assoc 0 (entget (car ob2)))))
(if (/= test "LINE")(princ "This is not a Line")(setq loop nil))
))
)
);** while end **
(setq ent2 (entget (car ob2))
s1 (cdr (assoc 10 ent1))
e1 (cdr (assoc 11 ent1))
l1 (cdr (assoc 8 ent1))
s2 (cdr (assoc 10 ent2))
e2 (cdr (assoc 11 ent2))
l2 (cdr (assoc 8 ent2))
p1 (distance s1 s2)
p2 (distance e1 s2)
p3 (distance s1 e2)
p4 (distance e1 e2)
la 1
lin 1
test nil
);** setq end **
(if (> p1 p2)
(progn
(setq p5 p1
sp (list '10 (car s1) (cadr s1))
ep (list '11 (car s2) (cadr s2))
);** setq end **
);** progn end **
(progn
(setq p5 p2
sp (list '10 (car e1) (cadr e1))
ep (list '11 (car s2) (cadr s2))
);** setq end **
);** progn end **
);** if end **
(if (< p5 p3)
(progn
(setq p5 p3
sp (list '10 (car s1) (cadr s1))
ep (list '11 (car e2) (cadr e2))
);** setq end **
);** progn end **
);** if end **
(if (< p5 p4)
(progn
(setq p5 p4
sp (list '10 (car e1) (cadr e1))
ep (list '11 (car e2) (cadr e2))
);** setq end **
);** progn end **
);** if end **
(setq ang1 (atof (angtos (angle (cdr sp) (cdr ep)) 0 3))
ang2 (atof (angtos (angle s1 e1) 0 3))
);** setq end **
(if (>= ang1 270) (setq ang1 (- ang1 180)))
(if (>= ang1 180) (setq ang1 (- ang1 180)))
(if (>= ang2 270) (setq ang2 (- ang2 180)))
(if (>= ang2 180) (setq ang2 (- ang2 180)))
(if (= ang1 ang2)
(progn
(command "_.Erase" ob2 "")
(setq ent1 (subst sp (assoc 10 ent1) ent1)
ent1 (subst ep (assoc 11 ent1) ent1)
);** setq end **
(entmod ent1)
(princ "Done")
(terpri)
);** progn end **
(progn
(redraw (car ob1) 4)
(redraw (car ob2) 4)
(alert "These 2 lines cannot be joined. Because\nthey are parellel or intersecting\nor they are not coplanar.")
);** else progn end **
);** if end **
)
(setq *error* olderr)
(command "_.UNDO" "_Group")
(setvar "cmdecho" 1)
(prin1)
);** end of lisp **

(defun c:LINEJOIN()(c:LJ))

(princ)

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

Em dùng thử thấy tốt và ưng ý rồi anh ơi,

nhưng em muốn sửa lại thêm 1 cái nữa cho đơn giản là :

Không cần : "\n Nhap chieu cao text: ""\n Kind of area : "

Chỉ cần ra kết quả là được rồi

Anh sửa thêm giúp em. Cảm ơn

Hề hề hề,

Thứ nhất, cái vụ nhập chiều cao text vốn là do bạn yêu cầu cơ mà, sao nay lại bỏ đi???

Thứ hai, nếu muốn bỏ đi như yêu cầu ở đây thì bạn hãy làm như sau:

1/- Với chiều cao text:

Xóa các dòng code

(setq h0 2)

(setq ht (getreal "\n Nhap chieu cao text: "))

(if (= ht nil)

(setq ht h0)

(setq h0 ht)

)

Thay thế bằng dòng code:

(setq ht 2)

hoặc thay giá trị 2 bằng giá trị mà bạn thích.

 

2/- Với kind of Area:

Xóa các dòng code:

(Setq ldt (Getstring t "\n Kind of area : "))

(cond

 

)

Thay thế bằng dòng code:

(setq ldt "")

 

Hề hề hề,

Chúc bạn vui.

  • Vote tăng 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

Các bro nào giúp em vụ này cái.

Em dùng lisp sau: link down về (My link)

 

Em sử dụng công cụ dimension, mỗi lần nhập tỉ lệ thì các thông số của dimension cũng thay đổi theo. Nói chung rất ok, chỉ có điều công ty em dùng dấu mũi tên là closed filled mà trong lisp lại mặc định là oblique, em lại ko biết sửa trong lisp như thế nào cho đúng, bro nào giỏi giúp em sửa lại chỗ đó nha. Em cám ơn nhìu ...!!!

 

Có thể gởi mail về địa chỉ cho em luôn được ko? Mail em đây: trandinhthuan@namtienco.com

 

Chúc các bro sức khỏe và thành công!!!!

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

Hề hề hề,

Thứ nhất, cái vụ nhập chiều cao text vốn là do bạn yêu cầu cơ mà, sao nay lại bỏ đi???

Thứ hai, nếu muốn bỏ đi như yêu cầu ở đây thì bạn hãy làm như sau:

 

Cảm ơn anh Thanh Bình nhiều nha

Em bỏ phần " chiều cao text " khi làm trên bản vẽ tính

Còn Lisp đầu " nhập chiều cao text " em làm trên bản vẽ trực tiếp không cần chỉnh sửa

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×