Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
daulau00

Lisp rải taluy trên đường cong

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

Thấy các bạn yêu cầu nhiều về lisp vẽ taluy và trên diễn đàn có share nhiều lisp. Tuy nhiên sau khi dùng thử mọi cái tôi thấy cái lisp của Lamteco đưa lên là hợp lý; tuy nhiên nó bị lỗi nên khi xài tôi phát hiện ra và hiệu chỉnh lại .

Các lệnh vẫn giữ nguyên:

1/ Khai báo các kiểu nét taluy dài ngắn, khoảng cách và số vạch ngắn chen giữa vạch dài = lệnh: VTL0;

2/ Vẽ taluy cho 1 đường riêng biệt = lệnh: VTL1, cho phép chọn đổi bên trái sang phải;

3/ Vẽ taluy chọn đường đỉnh mái taluy và đường chân mái taluy, cho phép đổi ngược lại = lệnh: VTL2.

(setq ktdoantaluy1 0.2 ktdoantaluy2 0.4 khoangcachtl 0.2 chieutaluy 1
sodoan 0 sodoanngan 4)
;Ve taluy tren 1 doan
(defun ve1doantaluy ( p1 p2 / pvt diemcu ktdoantaluy ketthuc )
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)

(Defun xddsd ( com epl kc / e0 e p dsd )
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
; ve ta luy cho 1 doi tuong
(Defun vetaluy ( ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
(= (cdr (assoc 0 e)) "SPLINE")
) (setq ketthuc 1))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE") (= (cdr (assoc 0 e)) "POLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
)
)
)
(setq dem dem)
)
(Defun C:vtl1 ( / il ill ep chon lai solan )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq ep 1)
(while ep
(setq solan 0 chieutaluy 1)
(setq ep (entsel))
(if ep
(progn
(setq solan (vetaluy ep))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(setq chieutaluy -1)
(command "_.Undo" solan)
(setq solan (vetaluy ep))
)
)
(setq chon nil)
)
(setvar "cecolor" il)
(setvar "osmode" ill)
(command "undo" "end")
)
(Defun C:vtl0 ( / tg )
(setq tg (getreal (strcat "Chieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
(if tg (setq ktdoantaluy1 tg))
(setq tg (getreal (strcat "Chieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
(if tg (setq ktdoantaluy2 tg))
(setq tg (getreal (strcat "Khoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
(if tg (setq khoangcachtl tg))
(setq tg (getint (strcat "So doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
(if tg (setq sodoanngan tg))
)

(Defun ve1doantaluy1 ( p1 p2 / d pv diemcu ktdoantaluy ketthuc )
(if (and p1 p2)
(progn
(setq ketthuc 1)
(setq pv (angle p1 p2))
(setq d (distance p1 p2))
(setq d (* d (/ ktdoantaluy1 ktdoantaluy2)))
(setq pv (polar p1 pv d))
(if (< sodoan sodoanngan)
(progn
(setq p2 pv)
(setq sodoan (1+ sodoan))
)
(progn
(setq p2 p2)
(setq sodoan 0)
)
)
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)
)
(setq dem dem)
)

(Defun vetaluy1 ( ep1 ep2 dao / le e1 e2 ketthuc them thutu )
(setq dem 0)
(setq e1 (entget (car ep1)))
(setq e2 (entget (car ep2)))
(if (and (or (= (cdr (assoc 0 e1)) "POLYLINE")
(= (cdr (assoc 0 e1)) "LINE")
(= (cdr (assoc 0 e1)) "ARC")
(= (cdr (assoc 0 e1)) "CIRCLE")
(= (cdr (assoc 0 e1)) "LWPOLYLINE")
(= (cdr (assoc 0 e1)) "SPLINE"))
(or (= (cdr (assoc 0 e2)) "POLYLINE")
(= (cdr (assoc 0 e2)) "LINE")
(= (cdr (assoc 0 e2)) "ARC")
(= (cdr (assoc 0 e2)) "CIRCLE")
(= (cdr (assoc 0 e2)) "LWPOLYLINE")
(= (cdr (assoc 0 e2)) "SPLINE"))
) (setq ketthuc 1))
(if (and (= (cdr (assoc 0 e1)) "POLYLINE") (= (cdr (assoc 0 e2)) "LWPOLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd1 (xddsd "_.Measure" ep1 khoangcachtl))
(setq dsd2 (xddsd "_.Divide" ep2 (length dsd1)))
(if dao
(setq dsd2 (reverse dsd2))
)
(repeat (length dsd1)
(setq p1 (nth thutu dsd1))
(setq p2 (nth thutu dsd2))
(setq thutu (1+ thutu))
(ve1doantaluy1 p1 p2)
)
)
)
(setq dem dem)
)

(Defun C:vtl2 ( / ep1 ep2 chon lai solan dsd1 dsd2 )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq solan 0 ep1 1 ep2 1)
(while (and ep1 ep2)
(setq chieutaluy 1)
(setq ep1 (entsel "\nDoi tuong thu nhat:"))
(setq ep2 (entsel "\nDoi tuong thu hai:"))
(if (and ep1 ep2)
(progn
(setq solan (vetaluy1 ep1 ep2 nil))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(command "_.Undo" solan)
(setq chieutaluy -1)
(setq solan (vetaluy1 ep2 ep1 nil))
)
)
(setq chon nil)
)
(command "undo" "end")
(setvar "cecolor" il)
(setvar "osmode" ill)
)

Mèo tui test thấy ngon không thua gì các lệnh RTL của Nova, các bạn test lại xem sao

mình thấy cái này rất hay nhưng thêm được mầu và layer khác nhau cho đoạn dài và đoạn ngắn thì ngon.

  • Like 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
Thấy các bạn yêu cầu nhiều về lisp vẽ taluy và trên diễn đàn có share nhiều lisp. Tuy nhiên sau khi dùng thử mọi cái tôi thấy cái lisp của Lamteco đưa lên là hợp lý; tuy nhiên nó bị lỗi nên khi xài tôi phát hiện ra và hiệu chỉnh lại .

Các lệnh vẫn giữ nguyên:

1/ Khai báo các kiểu nét taluy dài ngắn, khoảng cách và số vạch ngắn chen giữa vạch dài = lệnh: VTL0;

2/ Vẽ taluy cho 1 đường riêng biệt = lệnh: VTL1, cho phép chọn đổi bên trái sang phải;

3/ Vẽ taluy chọn đường đỉnh mái taluy và đường chân mái taluy, cho phép đổi ngược lại = lệnh: VTL2.

(setq ktdoantaluy1 0.2 ktdoantaluy2 0.4 khoangcachtl 0.2 chieutaluy 1
sodoan 0 sodoanngan 4)
;Ve taluy tren 1 doan
(defun ve1doantaluy ( p1 p2 / pvt diemcu ktdoantaluy ketthuc )
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)

(Defun xddsd ( com epl kc / e0 e p dsd )
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
; ve ta luy cho 1 doi tuong
(Defun vetaluy ( ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
(= (cdr (assoc 0 e)) "SPLINE")
) (setq ketthuc 1))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE") (= (cdr (assoc 0 e)) "POLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
)
)
)
(setq dem dem)
)
(Defun C:vtl1 ( / il ill ep chon lai solan )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq ep 1)
(while ep
(setq solan 0 chieutaluy 1)
(setq ep (entsel))
(if ep
(progn
(setq solan (vetaluy ep))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(setq chieutaluy -1)
(command "_.Undo" solan)
(setq solan (vetaluy ep))
)
)
(setq chon nil)
)
(setvar "cecolor" il)
(setvar "osmode" ill)
(command "undo" "end")
)
(Defun C:vtl0 ( / tg )
(setq tg (getreal (strcat "Chieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
(if tg (setq ktdoantaluy1 tg))
(setq tg (getreal (strcat "Chieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
(if tg (setq ktdoantaluy2 tg))
(setq tg (getreal (strcat "Khoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
(if tg (setq khoangcachtl tg))
(setq tg (getint (strcat "So doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
(if tg (setq sodoanngan tg))
)

(Defun ve1doantaluy1 ( p1 p2 / d pv diemcu ktdoantaluy ketthuc )
(if (and p1 p2)
(progn
(setq ketthuc 1)
(setq pv (angle p1 p2))
(setq d (distance p1 p2))
(setq d (* d (/ ktdoantaluy1 ktdoantaluy2)))
(setq pv (polar p1 pv d))
(if (< sodoan sodoanngan)
(progn
(setq p2 pv)
(setq sodoan (1+ sodoan))
)
(progn
(setq p2 p2)
(setq sodoan 0)
)
)
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)
)
(setq dem dem)
)

(Defun vetaluy1 ( ep1 ep2 dao / le e1 e2 ketthuc them thutu )
(setq dem 0)
(setq e1 (entget (car ep1)))
(setq e2 (entget (car ep2)))
(if (and (or (= (cdr (assoc 0 e1)) "POLYLINE")
(= (cdr (assoc 0 e1)) "LINE")
(= (cdr (assoc 0 e1)) "ARC")
(= (cdr (assoc 0 e1)) "CIRCLE")
(= (cdr (assoc 0 e1)) "LWPOLYLINE")
(= (cdr (assoc 0 e1)) "SPLINE"))
(or (= (cdr (assoc 0 e2)) "POLYLINE")
(= (cdr (assoc 0 e2)) "LINE")
(= (cdr (assoc 0 e2)) "ARC")
(= (cdr (assoc 0 e2)) "CIRCLE")
(= (cdr (assoc 0 e2)) "LWPOLYLINE")
(= (cdr (assoc 0 e2)) "SPLINE"))
) (setq ketthuc 1))
(if (and (= (cdr (assoc 0 e1)) "POLYLINE") (= (cdr (assoc 0 e2)) "LWPOLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd1 (xddsd "_.Measure" ep1 khoangcachtl))
(setq dsd2 (xddsd "_.Divide" ep2 (length dsd1)))
(if dao
(setq dsd2 (reverse dsd2))
)
(repeat (length dsd1)
(setq p1 (nth thutu dsd1))
(setq p2 (nth thutu dsd2))
(setq thutu (1+ thutu))
(ve1doantaluy1 p1 p2)
)
)
)
(setq dem dem)
)

(Defun C:vtl2 ( / ep1 ep2 chon lai solan dsd1 dsd2 )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq solan 0 ep1 1 ep2 1)
(while (and ep1 ep2)
(setq chieutaluy 1)
(setq ep1 (entsel "\nDoi tuong thu nhat:"))
(setq ep2 (entsel "\nDoi tuong thu hai:"))
(if (and ep1 ep2)
(progn
(setq solan (vetaluy1 ep1 ep2 nil))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(command "_.Undo" solan)
(setq chieutaluy -1)
(setq solan (vetaluy1 ep2 ep1 nil))
)
)
(setq chon nil)
)
(command "undo" "end")
(setvar "cecolor" il)
(setvar "osmode" ill)
)

Lisp vẽ taluy của Bạn rất hay, mong được bạn cải tiến thêm để giúp anh em, vi yêu cầu sau :

Nét dài và ngắn thể hiện màu khác nhau,

Khi cần hiệu chỉnh chọn taluy để hiệu chỉnh nét dài , nét ngắn khoảng cách.

Khi vẽ Taluy qua 2 đường vlt2 , khi khi đường chân có thay đổi thì nét chảy taluy sẽ được thay đổi theo.

Rất mong được Bạn giúp.

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ái này hình như là lisp tedi thì phải rải taluy khi vẽ ra kiểu 2 tức là vtl2 thì nó lại ra như thế này thì không đúng nhờ các cao thủ chỉnh lại giúp cho vì nó phải vuông góc với hai canh là 2 đường trắc polyline đã có trê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

Thêm cho anh em lisp ve taluy của tedi mình vừa tìm thấy trong máy mình, chắc là tuổi của nó cũng được tròn chục rui.

;;;=======================================
;;; TLF draw fill
;;; TLC draw cut
;;; TLSET Set global variable for double tl
;;; SETTL  set for single tl
;;; TL draw single TL
;;; USES WORLD COORDINATE SYSTEM
(setq distmin 1.0)
(setq distmax 3.5)
(setq segmin 1.0)
;====================================================================
(setq distmin 0.5) ; min distance between segment
(setq distmax 1.8) ; max distance between segment
(setq segmin 1.0) ; khoang cach noi suy khi ve ta luy
(setq kctl 1) ; distance between line
(setq dngan 1) ; Length of short line
(setq ddai 2) ; Length of long line
(setq chieutl 1)
(setq chieutl 1)
;=================================================================
;============== Doc toa do duong polyline =====
(defun readpl (pl / e l  ds p)
 (if (not (equal pl etcam)) (progn
   (setq ds '())
   (setq e (entget pl))
   (setq l (cdr (assoc 0 e)))
   (if (= l "POLYLINE")
       (progn
      	(setq pl (entnext pl))
      	(setq e (entget pl))
      	(setq l (cdr (assoc 0 e)))
      	(while  (= l "VERTEX")
               (setq p (cdr (assoc 10 e)))
               (setq ds (cons p ds))
               (setq pl (entnext pl))
               (setq e (entget pl))
               (setq l (cdr (assoc 0 e)))
      	)
       )
   )
   (if (= l "LINE")
       (setq ds (list
                	(cdr(assoc 11 e))
                	(cdr(assoc 10 e))
            	)
       )  
   )
   (setq ds (reverse ds))
   (if (= l "LWPOLYLINE")
  	(setq ds (xddstd pl)  )
   )
))
   (setq ds ds)
)
;;;--- Setup for taluy --
(defun c:tlset (/ minimum maximum )
   (setq minimum (getreal (strcat "Minimum Distance [" (rtos distmin 2 2) "]: " ) ))
   (if minimum (setq distmin minimum))
   (setq maximum (getreal (strcat "Maximum Distance [" (rtos distmax 2 2) "]: " ) ))
   (if maximum (setq distmax maximum))
   (setq maximum (getreal (strcat "Segmin  [" (rtos segmin 2 2) "]: " ) ))
   (if maximum (setq segmin maximum))
)
;;;---- lay ds td cua pline --
(defun xddstd ( pl / e ds len tt p)
 (setq minimum (getreal (strcat "Minimum Distance [" (rtos distmin 2 2) "]: " ) ))
   (if minimum (setq distmin minimum))
   (setq maximum (getreal (strcat "Maximum Distance [" (rtos distmax 2 2) "]: " ) ))
   (if maximum (setq distmax maximum))
   (setq maximum (getreal (strcat "Segmin  [" (rtos segmin 2 2) "]: " ) ))
   (if maximum (setq segmin maximum))
)
;;;--- Xac dinh doan gan nhat --
(defun xdmin(dstd p / p1 p2 len tt d dmin k)
   (setq len (length dstd))
   (setq tt 0)
   (setq k tt)
   (setq dmin (distance (car dstd) p))
   (repeat (-  len 1)
  	(setq p1 (nth tt dstd))
  	(setq tt (+ tt 1))    
  	(setq p2 (nth tt dstd))
  	(setq d (distance p1 p))
  	(if (< d dmin)
         (progn
           (setq  dmin d)
           (setq k (- tt 1))
         )
  	)
  	(setq d (distance p2 p))
  	(if (< d dmin)
         (progn
           (setq  dmin d)
           (setq k tt)
         )
  	)
   )
(if (> k 0)
 (setq tt (- k 1))
 (setq tt 0)
)
(setq p1 (nth tt dstd))
(setq tt (+ tt 1))    
(setq p2 (nth tt dstd))
(list p1 p2)
)
;----- Xac dinh chieu p - pl
(defun chieu ( p / ds a1 a2 a c)
 ;(setq ds (xddstd pl))
 (setq ds ds111 )
 (setq ds111 ds)
 (if ds (progn
	(setq ds (xdmin ds p))
	(setq a1 (angle (car ds) (cadr ds) ))
	(setq a2 (angle (car ds) p ))
	(setq a (- a2 a1))
	;(if (and (> a 0) (< a pi))
	(if  (> (sin a)  0)
       (setq c 1)
       (setq c -1)
	)
 ))
(setq c c)
)
;;;- ke mot duong thang  ---
(defun mkl (p1 p2 / e)
 (setq p1 (cons 10 p1)  )
 (setq p2 (cons 11 p2)  )
 (setq e (list
     '(0 . "LINE")
  	p1
  	p2
 ))  
 (entmake e)
)
;=================================
;;;============================================================
;;; Ve duong taluy
(defun tlx (/ dsp pl  p1 p2 ag  pc pl1 tt l sumdist dist pv overdist cl el pchieu)
 (setq ds111 nil)
 (setq pl (entsel "First Polyline"))
 (redraw (car pl) 3)
 (setq pl1 (entsel "\n Second Polyline"))
 (redraw (car pl1) 3)
 ;(setq pchieu (getpoint "\nside of Polyline"))
 (setq pchieu (cadr pl1))
 (redraw (car pl) 4)
 (redraw (car pl1) 4)
 (if (and pl pl1) (progn
	;;;---------------------
	;(setq dsp (xddstd (car pl)))
	(setq ds111 (dspm pl segmin))
	(setq dsp ds111)
	(setq dsxoa (ssadd))
	(setq pc (cadr pl1))
	(setq pl1 (car pl1))
	;------------------------
	(setq chieutl (chieu  pchieu))
	(setq tt 0)
	(setq l (-(length dsp)1))
	(setq sumdist 0)
	;--------
	(while (< tt l)
    	(progn
      	(setq distover (- sumdist))
      	(setq p1  (nth tt dsp))
      	(setq tt (+ tt 1))
      	(setq p2  (nth tt dsp))
      	(setq sumdist (distance p1 p2))
      	(setq pv (angle p1 p2))
      	(setq  p1 (polar p1 pv distover) );jjjj
      	(setq sumdist (- sumdist distover))
      	(while (> sumdist 0)
             (setq dist (veline p1 pv chieutl pl1))
             (if (or (not dist) (< dist distmin))
                 (setq dist distmin)
             )
             (if (> dist distmax)
                 (setq dist distmax)
             )
             (setq  p1 (polar p1 pv dist) )
             (setq sumdist (- sumdist dist))
      	)
    	)  
	)
	;-------
 ))  
 (setq dscuoi dsxoa)
)
;----- Xoa cuoi ---
(defun c:utl ()
  (command "ERASE" dsxoa "")
)
;---- Ve 1 duong va keo dai -----
(defun veline ( p1 ag chieutl pl1 / ag vd kq dist ec em)
               (setq ag (+ ag (*(/ pi 2)chieutl)) )  
               (setq p2 (polar p1 ag segmin))
               (mkl p1 p2)
               ;------------------
               (setq vd (entlast))
               (REDRAW VD 3)
               (setq ec (entget vd))
               (setq vd (list vd p2))
               (command "EXTEND" pl1 "" vd ""  )
               (setq vd (car vd))
               (setq em (entget vd))
               (if (equal ec em)
                	(entdel vd)
                	(progn
                       (setq p1 (cdr (assoc 10 em)))
                       (setq p2 (cdr (assoc 11 em)))
                       (setq kq (/(mykc p1 p2)2))
                       (setq dsxoa (ssadd vd dsxoa))
                	)
               )  
(setq kq kq)
)
;---- doi thanh doan dap ------
(defun nganf (vd / e p1 p2 d)
  (if vd (progn
     (setq e (entget vd))
     (setq p1 (cdr (assoc 10  e ) ))
     (setq p2 (cdr (assoc 11  e ) ))
     (setq d (/(mykc p1 p2)2))
     (if (> d distmax)
    	(setq d distmax)
     )
     (setq pv (angle p1 p2))
     (setq p2 (polar p1 pv d))
     (setq e (subst (cons 11 p2) (assoc 11 e) e ))  
     (entmod e)
     (entupd vd)
 ))
)
;---- ve ta luy dao --
(defun c:tlc ( / l tt e)
   (command "UNDO" "group")
   (setq dscuoi nil)
   (command "LAYER" "m" "TLCUT" "")
   (tlx)
   (if dscuoi
  	(progn
         (setq l (sslength dscuoi))
         (setq tt 0)
         (repeat (+(/ l 2)1)
        	(setq e (ssname dscuoi tt))
        	(setq tt (+ tt 2))
        	(nganc e)
         )  
  	)  
   )
   (command "UNDO" "end")
)
;---- doi thanh doan dao ------
(defun nganc (vd / e p1 p2 d)
  (if vd (progn
     (setq e (entget vd))
     (setq p1 (cdr (assoc 10  e ) ))
     (setq p2 (cdr (assoc 11  e ) ))
     (setq d (/(mykc p1 p2)2))
     (if (> d distmax)
    	(setq d  distmax)
     )
     (setq pv (angle p2 p1))
     (setq p1 (polar p2 pv d))
     (setq e (subst (cons 10 p1) (assoc 10 e) e ))  
     (entmod e)
     (entupd vd)
 ))
)
;---- ve ta luy dap --
(defun c:tlf ( / l tt e)
   (command "UNDO" "group")
   (command "LAYER" "m" "TLFIL" "")
   (setq dscuoi nil)
   (tlx)
   (if dscuoi
  	(progn
         (setq l (sslength dscuoi))
         (setq tt 0)
         (repeat (+(/ l 2)1)
        	(setq e (ssname dscuoi tt))
        	(setq tt (+ tt 2))
        	(nganf e)
         )  
  	)  
   )
   (command "UNDO" "end")
)
;-- tinh kc 2 diem ---
(defun mykc (p1 p2 / x1 y1 x2 y2 dx dy)
  (setq x1 (car p1))
  (setq y1 (cadr p1))
  (setq x2 (car p2))
  (setq y2 (cadr p2))
  (setq dx (- x2 x1))
  (setq dy (- y2 y1))
  (sqrt (+(* dx dx) (* dy dy)))
)
;--- Lay danh sach diem bang mesure ---
(defun dspm (e segmin /  el p dskq sst l)
  ;(setq e (entsel))
  (setq el (entlast))
  (setq sst (ssadd))
  (command "MEASURE" e segmin)
  (setq el (entnext el))
  (while el
     (setq p (cdr (assoc 10  (entget el) ) ))
     (setq l (cdr (assoc 0  (entget el) ) ))
     (if (and (= l "POINT") p)
       (setq dskq (cons p dskq))
     )
     (setq sst (ssadd el sst))
     (setq el (entnext el))
  )
(command "ERASE" sst "")
(setq dskq (reverse dskq))
)
;;;=======================================
TL - Ve taluy
;;;=======================================
;;; Ve ta luy
;;;-------------------------
;;; Ve duong taluy
(defun c:tl (/ pl  el e0 es p1 p2 ag ss ek cl  pc)
 (command "UNDO" "group")
 (command "LAYER" "m" "slopes" "")
 (setq pl (entsel))
 (if pl (progn
	(setq pc (getpoint "Side of TL"))
	(setq chieutl (chieupl (car pl) pc ))
	(setq el (entlast))
	(command "MEASURE" pl kctl)
	(setq ek (entlast))
	(setq ss (ssadd))
	;--------
	(while (and el
            	(not (equal el ek) )
           )
  	(setq el (entnext el))
  	(if el (setq ss (ssadd el ss)) )
  	(if el  
           (setq es (entnext el))
  	)
  	(if (and el es (= (cdr (assoc 0 (entget el))) "POINT") )
    	(progn
      	(setq p1 (cdr(assoc 10 (entget el))) 	)
      	(setq p2 (cdr(assoc 10 (entget es))) 	)
      	;-------------
      	(if (not(equal el ek))(progn
               (setq ag (angle p1 p2))
               (setq ag (+ ag (*(/ pi 2)chieutl)) )  
      	))
      	(if cl
             (setq p2 (polar p1 ag dngan))
             (setq p2 (polar p1 ag ddai))
      	)
      	(if cl
          	(setq cl nil)
          	(setq cl 1)
      	)
      	;(command "LINE" p1 p2 "")
      	(mkl p1 p2)
      	;---------------------
    	)  
  	)
	)
	;-------
	(command "ERASE" ss "")
 ))  
 (command "UNDO" "end")
)
;----------------
;----- Xac dinh chieu p - pl
(defun chieupl (pl p / ds a1 a2 a c)
 ;(setq ds (xddstd pl))
 (setq c 1)
 (setq ds (readpl pl))
 (if ds (progn
	(setq ds (xdmin ds p))

	(setq a1 (angle (car ds) (cadr ds) ))
	(setq a2 (angle (car ds) p ))
	(setq a (- a2 a1))
	(if (and (> a 0) (< a pi))
       (setq c 1)
       (setq c -1)
	)
 ))
(setq c c)
)

;;;;;;;;;;;;;;;
(defun c:settl (/ a1 a2 a3)
   (setq a1 (getstring (strcat "Distance between line " (rtos kctl 2 2) ": "  ) ))
   (setq a2 (getstring (strcat "\nLength of short line " (rtos dngan 2 2)": "  ) ))
   (setq a3 (getstring (strcat "\nLength of long line " (rtos ddai 2 2) ": " ) ))
   (if (/= a1 "")
  	(setq kctl (atof a1))
   )
   (if (/= a2 "")
  	(setq dngan (atof a2))
   )
   (if (/= a3 "")
  	(setq ddai (atof a3))
   )
)

;========= AUTO CONNECT 2d POLYLINE ==========
;;;; auto conevt 2 pl
(defun c:atc (/ ss ss1 ss2 l tt e0 l1 t1 e1 co)
(command "UNDO" "Group")
(setq co (getstring "Do you want to joint 2D LINE [y/n]:" ))
(if (= (strcase co nil) "Y") (progn

  (ltopl)
  (setq ss (ssget "X" '((0 . "POLYLINE" ) )   ))
  (if ss (progn
     (setq ss1 ss)
     (setq l (sslength ss))
     (setq tt 0)
     (repeat l
    	(setq e0 (ssname ss tt))
    	(setq tt (+ tt 1))
    	(if (and (entget e0) (> (sslength  ss1) 0)  ) (progn
          	(command "PEDIT" e0 "J" ss1 "" "")
    	))
    	(setq ss1 (locss ss1))
     )
  ))
 ))
  (command "UNDO" "end")
)
;;;; auto conevt 2 Line
(defun ltopl (/ ss ss1 ss2 l tt e0 l1 t1 e1 eg p1 p2)
  (setq ss (ssget "X" '((0 . "LINE" ) )   ))
  (if ss (progn
     (setq ss1 ss)
     (setq l (sslength ss))
     (setq tt 0)
     (repeat l
    	(setq e0 (ssname ss tt))
    	(setq tt (+ tt 1))
    	(setq eg (entget e0))
    	(setq p1 (cdr (assoc 10 eg) ))
    	(setq p2 (cdr (assoc 11 eg) ))
    	(if (= (nth 2 p1) (nth 2 p2))
             (command "PEDIT" e0 "Y"  "" )
    	)
     )
  ))
:leluoi:)
)
;;-----------------------------------
(defun locss (ss1 / ss2 l1 t1 e1)
    	(if ss1 (progn
        	(setq l1 (sslength ss1))
        	(setq t1 0)
        	(setq ss2 (ssadd) )
        	(repeat l1
               (setq e1 (ssname ss1 t1))
               (setq t1 (+ t1 1))
               (if (entget e1)  (setq ss2 (ssadd e1 ss2) ))
        	)
    	))
(setq ss1 ss2)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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ảm ơn bác philipdn nhiều, nhưng đúng là lisp của bác bất cập thật. Em thấy trường hợp chân taluy và đỉnh taluy mà không song song mà gấp khúc thì ký hiệu taluy không chuẩn và đẹp lắm. Không bít còn lisp nào ổn hơn không

Bác ơi, bác có thể kiểm tra lại cái lisp này không? nó bị lỗi thế này: khi viết một đoạn text bằng lệnh DT hoặc bất cứ cái gì liên quan đến góc như: Rotation, Obliquing, ... Cụ thể hơn: khi bản vẽ chưa app lisp này vào thì khi click vào đoạn text DT và bấm Ctrl +1 thì các thông số:

Contents: Giúp em với

Style: .VnArialNarrow

Annotative: No

Justify: Left

Height: 1.5

Rotation: 0

Width factory: 1.000

Obliquing: 0

...

Nhưng sau khi sử dụng lisp này thì:

 

Contents: Giúp em với

Style: .VnArialNarrow

Annotative: No

Justify: Left

Height: 1.5

Rotation: 90

Width factory: 1.000

Obliquing: 90

...

Tại sao lại thế và sửa lại lisp như thế nào?

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

Đây là Lisp mà tôi hay dùng, mọi người cùng thưởng thức

;;; ======================== VE DUONG TALUY - LENH B1 (BATTER) =========================
;;; ================================================================================

=======
;;;================================== Testlay (Tao ten va mau cho layer moi===============================
(defun testlay (lay co / tam)
	(setq datalay (list ""))     
		  	(setq tbl (tblnext "layer" 1))
		  	(while tbl
			  	(setq tam (cdr (assoc 2 tbl)))
		(setq datalay (append datalay (list tam)))
			  	(setq tbl (tblnext "layer"))
		       )
	(setq datalay (cdr datalay))
	(if (= (member lay datalay) nil)
    (command "LAYER" "n" lay "c" co lay  "s" lay "")
    (command "LAYER"   "s" lay "")
	)   
)
;; ============================================= Batter ================================================
(defun c:Batter()
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "aunits" 0)
  (setvar "angbase" (/ pi 2))
  (setvar "angdir" 1)
  (if (not lint) (setq lint 10.0))
  (setq int (getdist (strcat "\nInterval <" (rtos lint 2 3) ">: ")))
  (if int (setq lint int) (setq int lint))
  (command "line" (list 0.0 0.0) (list 0.0 0.0001) "")
  (if (tblsearch "block" "tadtick")
     (command "block" "tadtick" "y" (list 0.0 0.0) (entlast) "")
     (command "block" "tadtick" (list 0.0 0.0) (entlast) "")
  )
  (while (setq refent (entsel "\nSelect reference line: "))
 	(command "undo" "group")
 	(redraw (car refent) 3)
 	(initget 1 "Cut Fill")
 	(setq reply (getkword "\n[C]ut or [F]ill batter: "))
 	(setq s (ssget))
 	(command "measure" refent "b" "tadtick" "y" int)
 	(setq p (ssget "p") cn 0)
 	(if s
     (progn
		(while (< cn (sslength p))
	       (setq en (entget (ssname p cn)) p0 (cdr (assoc 10 en)) pt1 p0 pt2 nil b (cdr (assoc 50 en)))
	       (entdel (ssname p cn))
	       (setq p1 (polar p0 (+ (/ pi 2) B) 0.0001))
	       (command "line" p0 p1 "")
	       (command "extend" s "" (list (entlast) p1) "")
	       (setq xent (entget (entlast)))
	       (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))
	       (if (not (equal xdist 0.0001 0.0001))
		  	(setq pt2 (cdr (assoc 11 xent)))
		  	(progn
			     (command "extend" s "" (list (entlast) p0) "")
			     (setq xent (entget (entlast)))
			     (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))
			     (if (not (equal xdist 0.0001 0.0001))
					(setq pt2 (cdr (assoc 10 xent)))
			     )
		  	)
	       )
	       (entdel (entlast))
	       (if pt2
		  	(if (= reply "Fill")
			     (if (= (rem cn 2) 0) (command "line" pt1 pt2 "")
					(command "line" pt1 (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)) "")
			     )
			     (if (= (rem cn 2) 0) (command "line" pt2 pt1 "")
					(command "line" pt2 (polar pt2 (angle pt2 pt1) (/ (distance pt2 pt1) 2)) "")
			     )
		  	)
	       )
	       (setq cn (1+ cn))
		)
     )
 	)
 	(command "undo" "en")
  )
  (setvar "blipmode" 1)
  (princ)
)
(prompt "\nDraw cut/fill batter slope lines.")
;====================== BAT1 (BATTER)===========================================
(defun c:B1( / mode)

(testlay "BONG" "8")
(setvar "osmode" 0)
(c:batter)
(setvar "blipmode" 0)
(setvar "osmode" 167)
)

Bác ơi, bác có thể kiểm tra lại cái lisp này không? nó bị lỗi thế này: khi viết một đoạn text bằng lệnh DT hoặc bất cứ cái gì liên quan đến góc như: Rotation, Obliquing, ... Cụ thể hơn: khi bản vẽ chưa app lisp này vào thì khi click vào đoạn text DT và bấm Ctrl +1 thì các thông số:

Contents: Giúp em với

Style: .VnArialNarrow

Annotative: No

Justify: Left

Height: 1.5

Rotation: 0

Width factory: 1.000

Obliquing: 0

...

Nhưng sau khi sử dụng lisp này thì:

 

Contents: Giúp em với

Style: .VnArialNarrow

Annotative: No

Justify: Left

Height: 1.5

Rotation: 90

Width factory: 1.000

Obliquing: 90

...

Tại sao lại thế và sửa lại lisp như thế nào?

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

Theo mình thì cứ dùng cái lisp rải nhóm đồi tượng theo đường dẩn của mình thì rải được tất các kiểu taluy. Đầu vào là các nét taluy các bác cứ thay đổi thoải mái theo ý thích. Có quay hay không cũng theo ý thích thích dài ngắn thì rải nhiều lần, chọn điểm đầu phù hợp.

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ạn nói thế cũng đúng, nhưng vấn đề ở đây là đã có người đưa ra được cái lisp này thì chắc chắn phải có cách khắc phục được nó và cho ra một phiên bản mới tốt hơn. Cái mình cần là cái đấy cơ. HIHI;))

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

Đây là lisp tôi sưu tầm và chỉnh sửa lại chút ít, có thể rải taluy cho các loại line, pline, spline, arc, circle ...

(Mới dừng ở việc vẽ taluy cho 1 đường, phần vẽ mái taluy giữa 2 đường tôi chưa sửa xong)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;vtl;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl () 
(if (/= scale nil)
   (progn
     (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
     (if (not (setq scaletmp (getint thongbao)))
        (setq scaletmp scale)
     )
   )
   (progn
     (setq thongbao "Ty le ban ve ? <1/1000>:")
     (if (not (setq scaletmp (getint thongbao)))
         (setq scaletmp 1000)
     )
  )
)
(setq scale scaletmp)
(setq Defaultdist (* (* scale 2) 0.002))
(if (setq tg (getreal (strcat "\nKhoang cach ky hieu ta luy <" (rtos Defaultdist 2 2) ">:" ))) 
    (setq Defaultdist tg)
)
(setq	chieutaluy1 	1	sodoan 0  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(setq ktdoantaluy1 2    tg (getreal (strcat "\nChieu dai doan ngan<"  (rtos ktdoantaluy1 2 2)  ">:" ))  )
(if tg 
  (setq ktdoantaluy1 tg)
)
(setq ktdoantaluy2 6    tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:" ))  )
(if tg
   (setq ktdoantaluy2 tg)
)
(setq khoangcachtl 2    tg (getreal (strcat "\nKhoang cach giua cac doan<"  (rtos khoangcachtl 2 2)  ">:"  ))  )
(if tg
   (setq khoangcachtl tg)
)
(setq sodoanngan 3    tg (getint (strcat "\nSo doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0)  ">:"  ))  )
(if tg 
   (setq sodoanngan tg)
)
)
(Defun PlMake (Plist)			;  Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq	n  (length Plist)	ic 0  )
(while (< ic n)
   (entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist)))) 
   (setq ic (1+ ic))
)
(entmake '((0 . "SEQEND")))
)
;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
 (setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
 (setq ketthuc 1)
 (if (< sodoan sodoanngan)
   (progn
     (setq ktdoantaluy ktdoantaluy1)
     (setq sodoan (1+ sodoan))
   )
   (progn
     (setq ktdoantaluy ktdoantaluy2)
     (setq sodoan 0)
   )
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
 (setq e0 (entlast))
 (while e0
   (setq e e0)
   (setq e0 (entnext e0))
 )
 (command com epl kc)
 (setq e (entnext e))
 (while e
   (setq p (cdr (assoc 10 (entget e))))
   (if	p
     (setq dsd (cons p dsd))
   )
   (setq e (entnext e))
 )
 (command "_.Undo" 1)
 (setq dsd dsd)
)				   
;;; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
 (setq dem 0)
 (setq e (entget (car ep)))
 (if (or (= (cdr (assoc 0 e)) "LWPOLYLINE") (= (cdr (assoc 0 e)) "POLYLINE") (= (cdr (assoc 0 e)) "SPLINE") (= (cdr (assoc 0 e)) "LINE")
          (= (cdr (assoc 0 e)) "ARC") (= (cdr (assoc 0 e)) "CIRCLE") )
     (setq ketthuc 1)
     (prompt "\nDoi tuong duoc chon khong hop le")
 )
 (if ketthuc
   (progn
     (setq thutu 0)
     (setq dsd (xddsd "_.Measure" ep khoangcachtl))
     (setq p1 (car dsd))
     (repeat (1- (length dsd))
         (setq thutu (1+ thutu))
         (setq p2 (nth thutu dsd))
         (ve1doantaluy p1 p2)
         (setq p1 p2)
     )
   )
 )
 (setq dem dem)
)
;;;==================================================
(Defun C:vtl1 (/ ep chon lai solan chon)
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (command "undo" "g")
 (nsl)
 (setq ep 1)
 (while ep
   (setq solan	0  	chieutaluy 1    )
   (setq ep (entsel "\nChon doi tuong ve ta luy..."))
   (if	ep
     (progn
       (nsl1)
       (setq solan (vetaluy ep))
       (initget "Undo Change")
       (while  	(setq chon (getkword "Undo/Change <enter for exit>: "))
            (if (= chon "Undo")
                (command "_.Undo" solan)
            )
            (if (= chon "Change")
                (progn
                   (nsl1)
                   (setq chieutaluy -1)
                   (command "_.Undo" solan)
                   (setq solan (vetaluy ep))
                )
            )
            (initget "Undo Change")
        )
     )
   )
)
(command "undo" "e")
)

Nhờ các bác chỉnh sửa lại lisp giúp em các vấn đề sau:

 

1. Lưu số liệu lần nhập trước

2. Sau khi kết thúc lệnh bằng Enter (Undo/Change <enter for exit>) thì tự đóng block đối tượng vừa sinh ra với tên block cho nhập mới vào (với layer hiện hành)

3. Kết thúc bằng Enter không thực hiện tiếp lệnh VTL1

4. Khắc phục nill khi kết thúc lệnh Enter

5. Khi thực hiện lệnh [ Undo/Change <enter for exit>: *Cancel* ] để thay đổi phía rải taluy, không hỏi lại các tham số nữa mà thực hiện luôn

6. Khắc phục không đổi lệnh VLT1 thành lệnh khác được (giả sử thành lệnh VTL) (em thấy các lisp khác đổi lệnh được thông qua ký tự C:LLL thành tên lệnh mong muốn)

6. Khắc phụ lỗi không rải taluy hết đường và không vuông góc với đường như hình:17200_17200_hinh.jpg

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

Mình thấy lisp của bạn thật hay. Tuy nhiên khi rải taluy thì nếu mình chọn vào đường cần rải thì nó sẽ rải hết đường đó. Tuy nhiên có 1 điều là ví dụ như đường mình cần rải ta luy là đường Polyline rất dài nhưng mình chỉ cần rải 1 đoạn trên đường Polyline này (Ví dụ từ A->B chẳng hạng).

Rất mong mấy anh em viết thêm đoạn code để mình có thể chọn vị trí rải theo kiểu: Chọn đường cần

rải taluy-> pick chọn đường đó. " Vị trí bắt đầu rải taluy->pick trên đường cần rải taluy; Vị trí kết thúc rải taluy-> pick lên đường rải ta luy điểm này. Nếu ta pick các điểm bắt đầu rải và kết thúc rải không thuộc đường cần rải taluy mình chọn ban đầu thì lisp sẽ hỏi pick lại đến khi pick đúng.

Khi đó lisp chỉ rải trên đoạn mình vừa chọn.

Cái này mình thấy anh Duy đã viết cho cái lisp " Rải đối tượng theo đường dẫn".

và đầy là lisp của anh Duy đã viết để rải đối tượng theo đường dẫn

 

http://www.cadviet.com/upfiles/3/104866_rai_doi_tuong_theo_duong_chuan_rtd.lsp

Rất mong các anh giúp đỡ

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 sửa lại lisp giúp em các vấn đề sau:

 

1. Lưu số liệu lần nhập trước

2. Sau khi kết thúc lệnh bằng Enter (Undo/Change <enter for exit>) thì tự đóng block đối tượng vừa sinh ra với tên block cho nhập mới vào (với layer hiện hành)

3. Kết thúc bằng Enter không thực hiện tiếp lệnh VTL1

4. Khắc phục nill khi kết thúc lệnh Enter

5. Khi thực hiện lệnh [ Undo/Change <enter for exit>: *Cancel* ] để thay đổi phía rải taluy, không hỏi lại các tham số nữa mà thực hiện luôn

6. Khắc phục không đổi lệnh VLT1 thành lệnh khác được (giả sử thành lệnh VTL) (em thấy các lisp khác đổi lệnh được thông qua ký tự C:LLL thành tên lệnh mong muốn)

6. Khắc phụ lỗi không rải taluy hết đường và không vuông góc với đường như hình:

Hề hề hề,

1/- Đã sửa

2/- Đã sửa

3/- Đã sửa

4/- Đã sửa

5/- Đã sửa.

6.1/- Không sửa. Nếu bạn muốn vậy hãy nhét lisp này vào file vlx.

6.2 a/- Đã sửa

6.2 b/- Không sửa vì lisp này sử dụng vẽ nét taluy vuông góc với đường nối hai điểm chân taluy chứ không phải vuông góc với đường rải ta luy. Nếu bạn muốn vậy thì cần làm lisp theo giải thuật khác.

Nếu mình đoán không sai thì lisp này là của bác Duy. Mạn phép bác chỉnh sửa một chút cho bạn SoftvnBin xài thử

 

Đây là cái đã sửa, bạn dùng thử nhé và cho ý kiến để mình hoàn thiện thêm.



;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(defun nsl ()
(if (/= scale nil)
   (progn
        (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
        (if (not (setq scaletmp (getint thongbao)))
           (setq scaletmp scale)
        )
   )
   (progn
        (setq thongbao "Ty le ban ve ? <1/1000>:")
        (if (not (setq scaletmp (getint thongbao)))
            (setq scaletmp 1000)
        )
   )
)

(setq scale scaletmp)

(setq Defaultdist (* (* scale 2) 0.002))
(if (setq tg (getreal (strcat "\nKhoang cach ky hieu ta luy <" (rtos Defaultdist 2 2) ">:")))
      (setq Defaultdist tg)
)

(setq chieutaluy1 1 sodoan 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(if (not ktdoantaluy1)
   (setq ktdoantaluy1 250  tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
   (setq ktdoantaluy1 tg tg nil)
)
(if (not ktdoantaluy2)
   (setq ktdoantaluy2 500 tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
   (setq ktdoantaluy2 tg tg nil)
)
(if (not khoangcachtl)
   (setq khoangcachtl 200 tg (getreal (strcat "\nKhoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
   (setq khoangcachtl tg tg nil)
)
(if (not sodoanngan)
   (setq sodoanngan 1 tg (getint (strcat "\nSo doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
)
(if tg
   (setq sodoanngan tg tg nil)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PlMake (Plist) ; Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq n (length Plist)
ic 0
)
(while (< ic n)
(entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
(setq ic (1+ ic)
)
)
(entmake '((0 . "SEQEND")))

)


;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
;;;;(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq sodoan 0)
(setq ss (ssadd))
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
(= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "SPLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
)

(setq ketthuc 1)
(prompt "\nDoi tuong duoc chon khong hop le")
)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)

;;;==================================================
(Defun C:VTL1 (/ ep chon lai solan chon ss tg)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "g")
;;;;(nsl)

(setq ep 1)
(while ep
      (setq solan 0  chieutaluy 1)
      (setq ep (entsel "\nChon doi tuong ve ta luy..."))
      (if ep
           (progn
                  (nsl1)
                  (setq solan (vetaluy ep))
                  (initget "Undo Change")
                  (while
                           (setq chon (getkword "Undo/Change <enter for exit>: "))
                           (if (= chon "Undo")
                               (command "_.Undo" solan)
                           )
                           (if (= chon "Change")
                               (progn
                                       (nsl1)
                                       (setq chieutaluy -1)
                                       (command "_.Undo" solan)
                                       (setq solan (vetaluy ep))
                               )
                            )
                            (initget "Undo Change")
                   )
                   (setq blname (getstring t "\n Nhap ten block ban muon: "))
                   (if (/= blname "")
                       (command "block" blname (list 0.0 0.0 0.0) ss "")
                   )
                   (setq ep nil)
            )
        )
)
(command "undo" "e")
(princ)
)

 

Hề hề hề,

Cách dùng lisp này vẫn u như kỵ, chỉ lưu ý khi lisp yêu cầu nhập tên block, nếu bạn không muốn tạo block thì chỉ cần nhấn enter để bỏ qua.

Chúc bạn vui.

Chỉnh sửa theo phamthanhbinh
Sửa lỗi lisp
  • Vote tăng 2

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

Mình thấy lisp của bạn thật hay. Tuy nhiên khi rải taluy thì nếu mình chọn vào đường cần rải thì nó sẽ rải hết đường đó. Tuy nhiên có 1 điều là ví dụ như đường mình cần rải ta luy là đường Polyline rất dài nhưng mình chỉ cần rải 1 đoạn trên đường Polyline này (Ví dụ từ A->B chẳng hạng).

Rất mong mấy anh em viết thêm đoạn code để mình có thể chọn vị trí rải theo kiểu: Chọn đường cần

rải taluy-> pick chọn đường đó. " Vị trí bắt đầu rải taluy->pick trên đường cần rải taluy; Vị trí kết thúc rải taluy-> pick lên đường rải ta luy điểm này. Nếu ta pick các điểm bắt đầu rải và kết thúc rải không thuộc đường cần rải taluy mình chọn ban đầu thì lisp sẽ hỏi pick lại đến khi pick đúng.

Khi đó lisp chỉ rải trên đoạn mình vừa chọn.

Cái này mình thấy anh Duy đã viết cho cái lisp " Rải đối tượng theo đường dẫn".

và đầy là lisp của anh Duy đã viết để rải đối tượng theo đường dẫn

 

http://www.cadviet.c...g_chuan_rtd.lsp

Rất mong các anh giúp đỡ

Hề hề hề,

Bạn dùng thủ cái mình sửa này coi có ưng không nhé


;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(defun nsl ()
(if (/= scale nil)
   (progn
        (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
        (if (not (setq scaletmp (getint thongbao)))
           (setq scaletmp scale)
        )
   )
   (progn
        (setq thongbao "Ty le ban ve ? <1/1000>:")
        (if (not (setq scaletmp (getint thongbao)))
            (setq scaletmp 1000)
        )
   )
)

(setq scale scaletmp)

(setq Defaultdist (* (* scale 2) 0.002))
(if (setq tg (getreal (strcat "\nKhoang cach ky hieu ta luy <" (rtos Defaultdist 2 2) ">:")))
      (setq Defaultdist tg)
)

(setq chieutaluy1 1 sodoan 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()

   (setq ktdoantaluy1 250  tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))

(if tg
   (setq ktdoantaluy1 tg)
)

   (setq ktdoantaluy2 500 tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))

(if tg
   (setq ktdoantaluy2 tg)
)

   (setq khoangcachtl 200 tg (getreal (strcat "\nKhoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))

(if tg
   (setq khoangcachtl tg)
)

   (setq sodoanngan 1 tg (getint (strcat "\nSo doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))

(if tg
   (setq sodoanngan tg)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PlMake (Plist) ; Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq n (length Plist)
ic 0
)
(while (< ic n)
(entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
(setq ic (1+ ic)
)
)
(entmake '((0 . "SEQEND")))

)


;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
(setq dem 0)

(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
(= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "SPLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
)

(setq ketthuc 1)
(prompt "\nDoi tuong duoc chon khong hop le")
)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq d1 (vlax-curve-getdistatpoint (car ep) (vlax-curve-getclosestpointto (car ep) (getpoint "\n Chon diem bat dau rai taluy")))
         d2 (vlax-curve-getdistatpoint (car ep) (vlax-curve-getclosestpointto (car ep) (getpoint "\n Chon diem ket thuc rai taluy")))
)          
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(if (or (and (<= d1 (vlax-curve-getdistatpoint (car ep) p1)) (>= d2 (vlax-curve-getdistatpoint (car ep) p1)))
         (and (<= d2 (vlax-curve-getdistatpoint (car ep) p1)) (>= d1 (vlax-curve-getdistatpoint (car ep) p1)))  )
    (ve1doantaluy p1 p2)
)
(setq p1 p2)

)
)
)
(setq dem dem)
)

;;;==================================================
(Defun C:VTL1 (/ ep chon lai solan chon ss tg)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "g")
(nsl)

(setq ep 1)
(while ep
      (setq solan 0  chieutaluy 1)
      (setq ep (entsel "\nChon doi tuong ve ta luy..."))
      (if ep
           (progn
                  (nsl1)
                  (setq solan (vetaluy ep))
                  (initget "Undo Change")
                  (while
                           (setq chon (getkword "Undo/Change <enter for exit>: "))
                           (if (= chon "Undo")
                               (command "_.Undo" solan)
                           )
                           (if (= chon "Change")
                               (progn
                                       (nsl1)
                                       (setq chieutaluy -1)
                                       (command "_.Undo" solan)
                                       (setq solan (vetaluy ep))
                               )
                            )
                            (initget "Undo Change")
                   )

            )
        )
)
(command "undo" "e")
(princ)
)

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

Hề hề hề,

1/- Đã sửa

2/- Đã sửa

3/- Đã sửa

4/- Đã sửa

5/- Đã sửa.

6.1/- Không sửa. Nếu bạn muốn vậy hãy nhét lisp này vào file vlx.

6.2 a/- Đã sửa

6.2 b/- Không sửa vì lisp này sử dụng vẽ nét taluy vuông góc với đường nối hai điểm chân taluy chứ không phải vuông góc với đường rải ta luy. Nếu bạn muốn vậy thì cần làm lisp theo giải thuật khác.

Nếu mình đoán không sai thì lisp này là của bác Duy. Mạn phép bác chỉnh sửa một chút cho bạn SoftvnBin xài thử

 

Đây là cái đã sửa, bạn dùng thử nhé và cho ý kiến để mình hoàn thiện thêm.


;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(if (not ktdoantaluy1)
   (setq ktdoantaluy1 250  tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
   (setq ktdoantaluy1 tg)
)
(if (not ktdoantaluy2)
   (setq ktdoantaluy2 500 tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
   (setq ktdoantaluy2 tg)
)
(if (not khoangcachtl)
   (setq khoangcachtl 200 tg (getreal (strcat "\nKhoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
   (setq khoangcachtl tg)
)
(if (not sodoanngan)
   (setq sodoanngan 1 tg (getint (strcat "\nSo doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
)
(if tg
   (setq sodoanngan tg)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PlMake (Plist) ; Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq n (length Plist)
ic 0
)
(while (< ic n)
(entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
(setq ic (1+ ic)
)
)
(entmake '((0 . "SEQEND")))

)


;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
;;;;(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
(setq dem 0)
;;;(setq sodoan 0)
(setq ss (ssadd))
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
(= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "SPLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
)

(setq ketthuc 1)
(prompt "\nDoi tuong duoc chon khong hop le")
)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)

;;;==================================================
(Defun C:VTL1 (/ ep chon lai solan chon ss tg)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "g")
;;;;(nsl)

(setq ep 1)
(while ep
  	(setq solan 0  chieutaluy 1)
  	(setq ep (entsel "\nChon doi tuong ve ta luy..."))
  	(if ep
           (progn
              	(nsl1)
              	(setq solan (vetaluy ep))
              	(initget "Undo Change")
              	(while
                           (setq chon (getkword "Undo/Change <enter for exit>: "))
                           (if (= chon "Undo")
                               (command "_.Undo" solan)
                           )
                           (if (= chon "Change")
                               (progn
                                       (nsl1)
                                       (setq chieutaluy -1)
                                       (command "_.Undo" solan)
                                       (setq solan (vetaluy ep))
                               )
                        	)
                        	(initget "Undo Change")
                   )
                   (setq blname (getstring t "\n Nhap ten block ban muon: "))
                   (if (/= blname "")
                       (command "block" blname (list 0.0 0.0 0.0) ss "")
                   )
                   (setq ep nil)
        	)
    	)
)
(command "undo" "e")
(princ)
)

 

Hề hề hề,

Cách dùng lisp này vẫn u như kỵ, chỉ lưu ý khi lisp yêu cầu nhập tên block, nếu bạn không muốn tạo block thì chỉ cần nhấn enter để bỏ qua.

Chúc bạn vui.

Cảm ơn phamthanhbinh đã giúp mình, nhưng bị lỗi, bạn xem giúp mình nhé:

 

Command: vtl1

 

Chon doi tuong ve ta luy...

Chieu dai doan ngan<250.00>:25

Chieu dai doan dai<500.00>:50

Khoang cach giua cac doan<200.00>:20

So doan ngan trong 1 doan dai<1>:

; error: bad argument type: numberp: nil

 

Khi thuc hien lai lenh

 

Command: vtl1

Chon doi tuong ve ta luy...; error: bad argument type: numberp: nil

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ảm ơn phamthanhbinh đã giúp mình, nhưng bị lỗi, bạn xem giúp mình nhé:

 

Command: vtl1

 

Chon doi tuong ve ta luy...

Chieu dai doan ngan<250.00>:25

Chieu dai doan dai<500.00>:50

Khoang cach giua cac doan<200.00>:20

So doan ngan trong 1 doan dai<1>:

; error: bad argument type: numberp: nil

 

Khi thuc hien lai lenh

 

Command: vtl1

Chon doi tuong ve ta luy...; error: bad argument type: numberp: nil

Hề hề hề,

Xin lỗi bạn vì mình chưa test kỹ.

Bạn down lại lisp từ bài trước,(mình đã sửa rồi) để test lại 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

Dạ em xin cảm ơn anh phamthanhbinh

Chúc anh và cả nhà sức khỏe.

Nhân đây anh cho em hỏi để post bài mới mình vào chỗ nào vậy anh.

Thực sự em đã vào diễnn đàn để xem cách post bài mới nhưng em không tìm thấy nút post image đâu cả.

Rất mong anh chỉ giúp em.

Xin chân thành cảm ơn anh em

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 chào anh phamthanhbinh.

Nếu như cái lisp vtl1 mà anh đã sửa giúp em anh thêm chức năng lưu lại các thông số của bước trước đó nữa được không anh.

Nếu được anh giúp em với.

Thêm chức năng này nữa là thuận lợi cho công việc hơn a ạ

Xin cảm ơn anh

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 chào anh phamthanhbinh.

Nếu như cái lisp vtl1 mà anh đã sửa giúp em anh thêm chức năng lưu lại các thông số của bước trước đó nữa được không anh.

Nếu được anh giúp em với.

Thêm chức năng này nữa là thuận lợi cho công việc hơn a ạ

Xin cảm ơn anh

Hề hề hề,

1/- Cái nút post image nó nằm trên thanh công cụ của cửa sổ bạn dùng để post bài

5194_mh3.jpg

2/- Bạn có thể chép đoạn hàm con nsl1 từ bài post của mình trả lời bạn softvnbin để thay thế cho cái hàm con nsl1 trong lisp mình gửi bạn là Ok. Mình đã tách bạch các hàm con trong lisp rồi, bạn có thể dễ dàng thay thế nó, đúng không????

Chúc bạn thành công.

  • 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

Hề hề hề,

1/- Đã sửa

2/- Đã sửa

3/- Đã sửa

4/- Đã sửa

5/- Đã sửa.

6.1/- Không sửa. Nếu bạn muốn vậy hãy nhét lisp này vào file vlx.

6.2 a/- Đã sửa

6.2 b/- Không sửa vì lisp này sử dụng vẽ nét taluy vuông góc với đường nối hai điểm chân taluy chứ không phải vuông góc với đường rải ta luy. Nếu bạn muốn vậy thì cần làm lisp theo giải thuật khác.

Nếu mình đoán không sai thì lisp này là của bác Duy. Mạn phép bác chỉnh sửa một chút cho bạn SoftvnBin xài thử

 

Đây là cái đã sửa, bạn dùng thử nhé và cho ý kiến để mình hoàn thiện thêm.



;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(defun nsl ()
(if (/= scale nil)
   (progn
	(setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
	(if (not (setq scaletmp (getint thongbao)))
           (setq scaletmp scale)
	)
   )
   (progn
	(setq thongbao "Ty le ban ve ? <1/1000>:")
	(if (not (setq scaletmp (getint thongbao)))
			(setq scaletmp 1000)
	)
   )
)

(setq scale scaletmp)

(setq Defaultdist (* (* scale 2) 0.002))
(if (setq tg (getreal (strcat "\nKhoang cach ky hieu ta luy <" (rtos Defaultdist 2 2) ">:")))
  	(setq Defaultdist tg)
)

(setq chieutaluy1 1 sodoan 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(if (not ktdoantaluy1)
   (setq ktdoantaluy1 250  tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
   (setq ktdoantaluy1 tg tg nil)
)
(if (not ktdoantaluy2)
   (setq ktdoantaluy2 500 tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
   (setq ktdoantaluy2 tg tg nil)
)
(if (not khoangcachtl)
   (setq khoangcachtl 200 tg (getreal (strcat "\nKhoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
   (setq khoangcachtl tg tg nil)
)
(if (not sodoanngan)
   (setq sodoanngan 1 tg (getint (strcat "\nSo doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
)
(if tg
   (setq sodoanngan tg tg nil)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PlMake (Plist) ; Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq n (length Plist)
ic 0
)
(while (< ic n)
(entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
(setq ic (1+ ic)
)
)
(entmake '((0 . "SEQEND")))

)


;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
;;;;(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq sodoan 0)
(setq ss (ssadd))
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
(= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "SPLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
)

(setq ketthuc 1)
(prompt "\nDoi tuong duoc chon khong hop le")
)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)

;;;==================================================
(Defun C:VTL1 (/ ep chon lai solan chon ss tg)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "g")
;;;;(nsl)

(setq ep 1)
(while ep
  	(setq solan 0  chieutaluy 1)
  	(setq ep (entsel "\nChon doi tuong ve ta luy..."))
  	(if ep
           (progn
      			(nsl1)
      			(setq solan (vetaluy ep))
      			(initget "Undo Change")
      			(while
                           (setq chon (getkword "Undo/Change <enter for exit>: "))
                           (if (= chon "Undo")
                               (command "_.Undo" solan)
                           )
                           (if (= chon "Change")
                               (progn
                                       (nsl1)
                                       (setq chieutaluy -1)
                                       (command "_.Undo" solan)
                                       (setq solan (vetaluy ep))
                               )
                			)
                			(initget "Undo Change")
                   )
                   (setq blname (getstring t "\n Nhap ten block ban muon: "))
                   (if (/= blname "")
                       (command "block" blname (list 0.0 0.0 0.0) ss "")
                   )
                   (setq ep nil)
			)
	)
)
(command "undo" "e")
(princ)
)

 

Hề hề hề,

Cách dùng lisp này vẫn u như kỵ, chỉ lưu ý khi lisp yêu cầu nhập tên block, nếu bạn không muốn tạo block thì chỉ cần nhấn enter để bỏ qua.

Chúc bạn vui.

Cảm ơn bác PhamThanhBinh đã tận tình giúp đỡ, tuy nhiên sau khi test thì em thấy có lỗi như sau (lỗi một phần do em không diễn tả đúng ý mình (văn lùn quá :D ).

Em xin giả trình lại như sau:

 

Command: vtl1

 

Chon doi tuong ve ta luy...

Chieu dai doan ngan<250>:100 (250 là số liệu mặc định khi thực hiện lệnh VTL1 lần đầu tiên, 100 là số liệu nhập vào, lần thứ 2 khi thực hiện lệnh VTL1 thì sẽ chuyển thành Chieu dai doan ngan<100>:… 100 là số liệu lần cận kề dưới nó.

 

Chieu dai doan dai<500>:200 (Tương tự như trên)

 

Khoang cach giua cac doan<200>:100 (Tương tự như trên)

 

So doan ngan trong 1 doan dai<1>:2 (Tương tự như trên)

Undo/Change <enter for exit>:

 

Nhap ten block ban muon: mai duong 1

 

 

1. Lưu số liệu lần nhập trước (được giải trình như trên và dưới đây)

Khi thực hiện lệnh VTL1 lần 1 thì hỏi các thông số nhập vào

Khi thực hiện lệnh VTL1 lần 2, lần 3… thì vẫn hỏi các thông số nhập vào, nhưng cho số gợi nhớ các thông số đã nhập lần gần nhất.

Ví dụ: thực hiện lệnh VTL1 lần thứ nhất -> Khoang cach giua cac doan<200>:100, thì khi thực hiện lệnh VTL1 lần thứ hai sẽ nhớ -> Khoang cach giua cac doan<100>:150 (150 là số liệu mới nhập vào lần 2, 100 là số liệu lần nhập cận kề dưới nó (trong trường họp này chính là lần đầu tiên). Khi thực hiện lệnh VTL1 lần thứ ba sẽ nhớ số liệu nhập lần cận kề dưới nó (ở đây sẽ là Khoang cach giua cac doan<150>:.…. .)

 

2. Sau khi kết thúc lệnh bằng Enter (Undo/Change <enter for exit>) thì tự đóng block đối tượng vừa sinh ra với tên block cho nhập mới vào (với layer hiện hành)

(Khi nhập tên Block xong thì toàn bộ mái taluy vừa rải biến mất :) )

3. Kết thúc bằng Enter không thực hiện tiếp lệnh VTL1

(đã Oke!)

4. Khắc phục nill khi kết thúc lệnh Enter

(đã Oke!)

5. Khi thực hiện lệnh [ Undo/Change <enter for exit>: *Cancel* ] để thay đổi phía rải taluy, không hỏi lại các tham số nữa mà thực hiện luôn

(đã Oke!)

6. Khắc phục không đổi lệnh VLT1 thành lệnh khác được (giả sử thành lệnh VTL) (em thấy các lisp khác đổi lệnh được thông qua ký tự C:LLL thành tên lệnh mong muốn)

(đã Oke!)

7. Bác xem giúp em luôn chọn đối tượng rải -> chọn đoạn rải (thuộc đối tượng rải) -> từ điểm pick 1 đến điểm pick 2 đến điểm Pick 3 thì sẽ chỉ rải trong đoạn từ điểm pick 1 đến điểm pick 3 (theo chiều từ pick 1 đến pick 2 đến pick 3 (để khắc phục chiều rải trong hình kín) không ạ, em chân thành 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

Em xin cảm ơn anh phamthanhbinh.

Em đã làm như anh chỉ dẫn nhưng nó lại sinh ra như thế này.

Ý của em là như anh softvn Bin anh ạ

1. Nghĩa là lưu lại giá trị trước đó như thế này

1. Lưu số liệu lần nhập trước (được giải trình như trên và dưới đây)

Khi thực hiện lệnh VTL1 lần 1 thì hỏi các thông số nhập vào

Khi thực hiện lệnh VTL1 lần 2, lần 3… thì vẫn hỏi các thông số nhập vào, nhưng cho số gợi nhớ các thông số đã nhập lần gần nhất.

Ví dụ: thực hiện lệnh VTL1 lần thứ nhất -> Khoang cach giua cac doan<200>:100, thì khi thực hiện lệnh VTL1 lần thứ hai sẽ nhớ -> Khoang cach giua cac doan<100>:150 (150 là số liệu mới nhập vào lần 2, 100 là số liệu lần nhập cận kề dưới nó (trong trường họp này chính là lần đầu tiên). Khi thực hiện lệnh VTL1 lần thứ ba sẽ nhớ số liệu nhập lần cận kề dưới nó (ở đây sẽ là Khoang cach giua cac doan<150>:.…. .)

 

2.Vấn đề thứ hai em muốn nhờ anh Bình viết thêm giúp em đọa code là mình có thể chọn kiểu rải ta luy bên trái hoặc bên phải của đường cần rải nữa anh ạ.

Xin lỗi anh. Đúng ra em nhờ e phải nói 1 lần để a viết đỡ tốn thời gian của anh nhưng khi e ứng dụng lisp vào công việc mới phát sinh điều này.

Rất mong anh Bình thông cảm và giúp đỡ.

Em xin cảm ơn anh.

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

<p>

Cảm ơn bác PhamThanhBinh đã tận tình giúp đỡ, tuy nhiên sau khi test thì em thấy có lỗi như sau (lỗi một phần do em không diễn tả đúng ý mình (văn lùn quá :D ). Em xin giả trình lại như sau: Command: vtl1 Chon doi tuong ve ta luy... Chieu dai doan ngan<250>:100 (250 là số liệu mặc định khi thực hiện lệnh VTL1 lần đầu tiên, 100 là số liệu nhập vào, lần thứ 2 khi thực hiện lệnh VTL1 thì sẽ chuyển thành Chieu dai doan ngan<100>:… 100 là số liệu lần cận kề dưới nó. Chieu dai doan dai<500>:200 (Tương tự như trên) Khoang cach giua cac doan<200>:100 (Tương tự như trên) So doan ngan trong 1 doan dai<1>:2 (Tương tự như trên) Undo/Change <enter for exit>: Nhap ten block ban muon: mai duong 1 1. Lưu số liệu lần nhập trước (được giải trình như trên và dưới đây) Khi thực hiện lệnh VTL1 lần 1 thì hỏi các thông số nhập vào Khi thực hiện lệnh VTL1 lần 2, lần 3… thì vẫn hỏi các thông số nhập vào, nhưng cho số gợi nhớ các thông số đã nhập lần gần nhất. Ví dụ: thực hiện lệnh VTL1 lần thứ nhất -> Khoang cach giua cac doan<200>:100, thì khi thực hiện lệnh VTL1 lần thứ hai sẽ nhớ -> Khoang cach giua cac doan<100>:150 (150 là số liệu mới nhập vào lần 2, 100 là số liệu lần nhập cận kề dưới nó (trong trường họp này chính là lần đầu tiên). Khi thực hiện lệnh VTL1 lần thứ ba sẽ nhớ số liệu nhập lần cận kề dưới nó (ở đây sẽ là Khoang cach giua cac doan<150>:.…. .) 2. Sau khi kết thúc lệnh bằng Enter (Undo/Change <enter for exit>) thì tự đóng block đối tượng vừa sinh ra với tên block cho nhập mới vào (với layer hiện hành) (Khi nhập tên Block xong thì toàn bộ mái taluy vừa rải biến mất :) ) 3. Kết thúc bằng Enter không thực hiện tiếp lệnh VTL1 (đã Oke!) 4. Khắc phục nill khi kết thúc lệnh Enter (đã Oke!) 5. Khi thực hiện lệnh [ Undo/Change <enter for exit>: *Cancel* ] để thay đổi phía rải taluy, không hỏi lại các tham số nữa mà thực hiện luôn (đã Oke!) 6. Khắc phục không đổi lệnh VLT1 thành lệnh khác được (giả sử thành lệnh VTL) (em thấy các lisp khác đổi lệnh được thông qua ký tự C:LLL thành tên lệnh mong muốn) (đã Oke!) 7. Bác xem giúp em luôn chọn đối tượng rải -> chọn đoạn rải (thuộc đối tượng rải) -> từ điểm pick 1 đến điểm pick 2 đến điểm Pick 3 thì sẽ chỉ rải trong đoạn từ điểm pick 1 đến điểm pick 3 (theo chiều từ pick 1 đến pick 2 đến pick 3 (để khắc phục chiều rải trong hình kín) không ạ, em chân thành cảm ơn!
</p>

Hề hề hề,

Bạn nói làm mình buồn quá. Vậy sao gọi là lisp bị lỗi mà phải gọi là nó chưa đúng ý bạn chớ. Mình không phải là bạn nên làm sao có thể hiểu đúng hoàn toàn ý của bạn qua mấy lời trong bài post được.

Bạn hãy thử làm mấy việc sau để chỉnh lại cái lisp đó xem nó đã đúng ý bạn chưa nhé.

1/- Mở lisp ra tìm tới đoạn code hàm con (defun nsl1...) Sửa đoạn :

 

 

(if (not ktdoantaluy1)

(setq ktdoantaluy1 250 tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))

 

)

thành:

 

 

(if (not ktdoantaluy1)

(setq ktdoantaluy1 250 tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))

(setq tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))

)

 

2/- Với các biến ktdoantaluy2, khoangcachtl, sodoanngan bạn cũng sửa tương tự như trên với lưu ý đổi tên biến cho phù hợp.

 

3/- Tiếp tục tìm xuống đoạn code của hàm chính VTL1. Copy dòng code

(nsl1)

 

Dán dòng này vào ngay phía dưới dòng code :

(setq ep (entsel "\nChon doi tuong ve ta luy..."))

 

Đồng thời xóa bỏ cả hai dòng code (nsl1) cũ có trong hàm chính

 

4/- Tiếp tục tìm trong hàm chính VTL1 tới dòng code:

(command "block" blname (list 0.0 0.0 0.0) ss "" )

 

Sửa nó thành dòng code:

(command "block" blname (list 0.0 0.0 0.0) ss "" "oops")

 

5/- Lưu lại file và test thử coi.

 

Về yêu cầu cuối cùng của bạn, mình không hiểu được vì sao phải pick 3 điểm vì mỗi pline chỉ có một chiều nhất định. Nếu bạn thấy pick 2 điểm là đủ thì bạn có thể tham khảo code mình đã sửa cho bạn hotanphi. Nếu vẫn bắt buộc phải là 3 điểm thì bạn hãy tạo một pline mới qua 3 điểm đó và rải taluy trên pline vừa vẽ là OK. (Bạn lưu ý rằng : mỗi pline đều có điểm đâu và điểm cuối xác định, vì thế yêu cầu của bạn chọn 3 điểm trên pline kín sẽ có khả năng xảy ra là theo chiều bạn chọn điểm đầu và cuôi của pline nằm tọt vào trong đó và sẽ khó mà rải taluy.)

 

@ Bạn Hotanphi:

Yêu cầu 1 của bạn hãy tham khảo ở trên đây.

Yêu cầu 2 của bạn trong lisp đã có giải quyết rồi bằng cách lựa chọn Change khi lisp hỏi. Lisp không phân biệt phải hay trái mà phân biệt theo chiều của polyline. Vì thế bạn cứ rải bình thường, nếu thấy đúng chiều rồi thì Ok còn nếu chưa thì change là được

  • 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

Sao không dùng lintype dạng taluy |i| vẽ tiện hơn không ? giải quyết đường tròn, arc và spline dễ dàng

 

e.jpg.

 

Cách này good nè. Nhẹ file nữ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

<p></p>

Hề hề hề,

Bạn nói làm mình buồn quá. Vậy sao gọi là lisp bị lỗi mà phải gọi là nó chưa đúng ý bạn chớ. Mình không phải là bạn nên làm sao có thể hiểu đúng hoàn toàn ý của bạn qua mấy lời trong bài post được.

Bạn hãy thử làm mấy việc sau để chỉnh lại cái lisp đó xem nó đã đúng ý bạn chưa nhé.

1/- Mở lisp ra tìm tới đoạn code hàm con (defun nsl1...) Sửa đoạn :

 

 

(if (not ktdoantaluy1)

(setq ktdoantaluy1 250 tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))

 

)

thành:

 

 

(if (not ktdoantaluy1)

(setq ktdoantaluy1 250 tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))

(setq tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))

)

 

2/- Với các biến ktdoantaluy2, khoangcachtl, sodoanngan bạn cũng sửa tương tự như trên với lưu ý đổi tên biến cho phù hợp.

 

3/- Tiếp tục tìm xuống đoạn code của hàm chính VTL1. Copy dòng code

(nsl1)

 

Dán dòng này vào ngay phía dưới dòng code :

(setq ep (entsel "\nChon doi tuong ve ta luy..."))

 

Đồng thời xóa bỏ cả hai dòng code (nsl1) cũ có trong hàm chính

 

4/- Tiếp tục tìm trong hàm chính VTL1 tới dòng code:

(command "block" blname (list 0.0 0.0 0.0) ss "" )

 

Sửa nó thành dòng code:

(command "block" blname (list 0.0 0.0 0.0) ss "" "oops")

 

5/- Lưu lại file và test thử coi.

 

Về yêu cầu cuối cùng của bạn, mình không hiểu được vì sao phải pick 3 điểm vì mỗi pline chỉ có một chiều nhất định. Nếu bạn thấy pick 2 điểm là đủ thì bạn có thể tham khảo code mình đã sửa cho bạn hotanphi. Nếu vẫn bắt buộc phải là 3 điểm thì bạn hãy tạo một pline mới qua 3 điểm đó và rải taluy trên pline vừa vẽ là OK. (Bạn lưu ý rằng : mỗi pline đều có điểm đâu và điểm cuối xác định, vì thế yêu cầu của bạn chọn 3 điểm trên pline kín sẽ có khả năng xảy ra là theo chiều bạn chọn điểm đầu và cuôi của pline nằm tọt vào trong đó và sẽ khó mà rải taluy.)

 

@ Bạn Hotanphi:

Yêu cầu 1 của bạn hãy tham khảo ở trên đây.

Yêu cầu 2 của bạn trong lisp đã có giải quyết rồi bằng cách lựa chọn Change khi lisp hỏi. Lisp không phân biệt phải hay trái mà phân biệt theo chiều của polyline. Vì thế bạn cứ rải bình thường, nếu thấy đúng chiều rồi thì Ok còn nếu chưa thì change là được

Mình đã làm bạn buồn, xin lỗi bạn nhé, mình đã thay thế -> các vấn đề oke hết, duy chỉ còn vấn đề Block nữa thôi bạn ạ

Bạn giúp mình nốt nhé:

như thế này ạ:

 

 

Chon doi tuong ve ta luy...

Chieu dai doan ngan<250.00>:2.5

 

Chieu dai doan dai<500.00>:5

 

Khoang cach giua cac doan<200.00>:2

 

So doan ngan trong 1 doan dai<1>:

Undo/Change <enter for exit>: c

Undo/Change <enter for exit>:

 

Nhap ten block ban muon: duong 1

 

Sau khi nhập xong thì pick không thấy đóng Block "duong 1" mà chỉ khi dùng lệnh BE = BEDIT thì hiện ra như hình sau (có block "duong 1" nhưng Edit trong lệnh BE đó không có tác dụng khi close Block Editor)

Giúp mình nốt nhé!

17200_hinh_block.jpg

Cảm ơn bạn trước!

Lisp mình đã chỉnh theo lời bạn đây à!

http://www.cadviet.com/upfiles/3/17200_vtl1.lsp

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

Mình đã làm bạn buồn, xin lỗi bạn nhé, mình đã thay thế -> các vấn đề oke hết, duy chỉ còn vấn đề Block nữa thôi bạn ạ

Bạn giúp mình nốt nhé:

như thế này ạ:

 

 

Chon doi tuong ve ta luy...

Chieu dai doan ngan<250.00>:2.5

 

Chieu dai doan dai<500.00>:5

 

Khoang cach giua cac doan<200.00>:2

 

So doan ngan trong 1 doan dai<1>:

Undo/Change <enter for exit>: c

Undo/Change <enter for exit>:

 

Nhap ten block ban muon: duong 1

 

Sau khi nhập xong thì pick không thấy đóng Block "duong 1" mà chỉ khi dùng lệnh BE = BEDIT thì hiện ra như hình sau (có block "duong 1" nhưng Edit trong lệnh BE đó không có tác dụng khi close Block Editor)

Giúp mình nốt nhé!

17200_hinh_block.jpg

Cảm ơn bạn trước!

Lisp mình đã chỉnh theo lời bạn đây à!

http://www.cadviet.c.../17200_vtl1.lsp

Hề hề hề,

Vậy là mình lại hiểu sai ý bạn rồi.

Theo lisp mình nói bạn sửa thì chắc chắn block duong1 đã được tạo thành. Tuy nhiên các nét ta luy trên bản vẽ vẫn là các line rời rạc chứ không phải là các phần tử của một block do mình dùng lệnh "oops" để trả chúng về sau khi lệnh block đã thu gom chúng vào block duong1 của bạn. Vì bạn chỉ nói là muốn chúng hiện lại, nên mình mới hiểu nhầm ý bạn. Chắc ở đây bạn muốn chúng hiện lại ở dạng block cho dễ edit về sau chứ không phải là chỉ trả chúng về như khi tạo ra.

Nếu vậy thì bạn hãy làm như sau:

Thay dòng code : (command "block" blname (list 0.0 0.0 0.0) ss "" "oops")

Thành dòng code: (command "block" blname (list 0.0 0.0 0.0) ss "" "insert" blname (list 0.0 0.0 0.0) "" "" "")

Hy vọng lần này mình hiểu đúng ý bạn. Còn nếu sai thì bạn cần trình bày lại yêu cầu cho rành mạch hơn mới được.

  • 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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×