Đến nội dung


Hình ảnh
- - - - -

Nhờ chỉnh sửa LISP CUTDIM.


  • Please log in to reply
8 replies to this topic

#1 Ce.truonghai

Ce.truonghai

    Edu level: li2

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

Đã gửi 11 July 2013 - 01:41 PM

Tình hình là mình đã tìm kiếm nhiều các LISP CUTDIM khác nhau, nhưng vẫn còn 1 lỗi khá rắc rối chưa hoàn chỉnh. Nhờ các PRO xem chỉnh sửa lại dùm mình.

- LISP cắt Dim đã giải quyết được các DIM không phải trong UCS World, nhưng còn 1 lỗi nhỏ là khi 1 dim bị rút 1 Node về ngang với đường kích thước thì Cắt Dim sẽ cho về giá trị 0 (lệnh CD) và không nhúc nhích (lệnh BD).

 

;*******************************************************************************
;* WRITTEN BY DAO NGUYEN THANG 94X3 - HANOI ARCHITECTURAL UNIVERSITY (VIETNAM) *
;*******************************************************************************
(defun myerror (s)                    ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (cond
    ((= s "quit / exit abort") (princ))
    ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
  )
  (setvar "cmdecho" CMD)             ; Restore saved modes
  (setvar "osmode" OSM)
  (setq *error* OLDERR)               ; Restore old *error* handler
  (princ)
)
;*******************************************************************************
(DEFUN C:CD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
                PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
      *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
    (PROGN
	(SETQ DS (ENTGET (SSNAME SS DEM)))
	(SETQ KDL (CDR (ASSOC 0 DS)))
	(IF (= "DIMENSION" KDL)
	   (PROGN
		(SETQ PT10 (CDR (ASSOC 10 DS)))
		(SETQ PT11 (CDR (ASSOC 11 DS)))
		(SETQ PT13 (CDR (ASSOC 13 DS)))
		(SETQ PT14 (CDR (ASSOC 14 DS)))
		(SETQ N70 (CDR (ASSOC 70 DS)))
		(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
		   (PROGN
			(SETQ GOCY (ANGLE PT10 PT14))
			(SETQ GOCX (+ GOCY (/ PI 2)))
		   )
		)
		(SETVAR "OSMODE" 0)
		(SETQ PTI (POLAR PT GOCX 2))
		(SETQ PT13I (POLAR PT13 GOCY 2))
		(SETQ PT14I (POLAR PT14 GOCY 2))
		(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
		(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
		(SETQ O13 (ASSOC 13 DS))
		(SETQ O14 (ASSOC 14 DS))
		(SETQ N13 (CONS 13 PT13N))
		(SETQ N14 (CONS 14 PT14N))
		(SETQ DS (SUBST N13 O13 DS))
		(SETQ DS (SUBST N14 O14 DS))
		(ENTMOD DS)
	   )
	)
	(SETQ DEM (+ DEM 1))
    )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)               ; Restore old *error* handler
(PRINC)
)
;******************************************************************************

(DEFUN C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
                PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
      *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
    (PROGN
	(SETQ DS (ENTGET (SSNAME SS DEM)))
	(SETQ KDL (CDR (ASSOC 0 DS)))
	(IF (= "DIMENSION" KDL)
	   (PROGN
		(SETQ PT13 (CDR (ASSOC 13 DS)))
		(SETQ PT14 (CDR (ASSOC 14 DS)))
		(SETQ PT10 (CDR (ASSOC 10 DS)))
		(SETQ PT11 (CDR (ASSOC 11 DS)))
		(SETQ N70 (CDR (ASSOC 70 DS)))
		(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
		   (PROGN
			(SETQ GOCY (ANGLE PT10 PT14))
			(SETQ GOCX (+ GOCY (/ PI 2)))
		   )
		)
		(SETVAR "OSMODE" 0)
		(SETQ PTI (POLAR PT GOCX 2))
		(SETQ PT10I (POLAR PT10 GOCY 2))
		(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
		(SETQ KC (DISTANCE PT10 PT10N))
		(SETQ O10 (ASSOC 10 DS))
		(SETQ N10 (CONS 10 PT10N))
		(SETQ DS (SUBST N10 O10 DS))
		(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
		(SETQ O11 (ASSOC 11 DS))
		(SETQ N11 (CONS 11 PT11N))
		(SETQ DS (SUBST N11 O11 DS))
		(ENTMOD DS)
	   )
	)
	(SETQ DEM (+ DEM 1))
    )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)

Cảm ơn AE giúp đỡ,

Thân chào.


  • 0

#2 Ce.truonghai

Ce.truonghai

    Edu level: li2

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

Đã gửi 15 July 2013 - 08:30 AM

Không có ai giúp mình với....


  • 0

#3 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 19 July 2013 - 02:50 PM

Thật ra lisp này chạy không đúng khi dimension line không vuông góc với extension line (khi đã dùng lệnh oblique)
Bạn sửa dòng
(IF (= "DIMENSION" KDL)
thành
(IF (AND (= "DIMENSION" KDL) (> 2 (SETQ N70 (REM (CDR (ASSOC 70 DS)) 32)) ))
Sửa đoạn
(SETQ N70 (CDR (ASSOC 70 DS)))
(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
   (PROGN
    (SETQ GOCY (ANGLE PT10 PT14))
    (SETQ GOCX (+ GOCY (/ PI 2)))
   )
)

thành
(SETQ GOCX (IF (= N70 1)(ANGLE PT13 PT14)(CDR (ASSOC 50 DS))))
(SETQ GOCY (- GOCX (/ PI 2)))
 


  • 1

#4 lyky

lyky

    biết vẽ polygon

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

Đã gửi 19 July 2013 - 03:22 PM

Sau khi sửa theo bác NĐT xong, bạn có thể tổng hợp 2 phần riêng lẻ thành một code chung, phần bẫy lỗi bạn tự bổ xung nhé (bởi vì: theo ý mình phần bẫy lỗi - thiết định và phục hồi giá trị các biến hệ thống được thực hiện bằng các hàm riêng (như là một Public function))

(defun CBD (p / dem ds gocx gocy kdl lth n10 n11 n13 n14 n70 o10 o11 o13 o14 pt pt10 pt10i pt10n pt11 pt11n pt13 pt13i pt13n pt14 pt14i pt14n pti ss)
(princ "\nVui long chon vung dimmensions can thao tac:\n") (setq ss (ssget))
(setq pt (getpoint "\nPick diem moc:\n")) (setq pt (trans pt 1 0))
(setq lth (sslength ss)) (setq dem 0) (while (< dem lth) (progn
(setq ds (entget (ssname ss dem)) kdl (cdr (assoc 0 ds)))
(if (and (= "DIMENSION" kdl) (> 2 (setq n70 (rem (cdr (assoc 70 ds)) 32))))
  (progn
(setq pt10 (cdr (assoc 10 ds)) pt11 (cdr (assoc 11 ds))
      pt13 (cdr (assoc 13 ds)) pt14 (cdr (assoc 14 ds)))
(setq gocx (if (= n70 1) (angle pt13 pt14) (cdr (assoc 50 ds))))
(setq gocy (- gocx (/ pi 2)))
(setq pti   (polar pt   gocx 2)  pt13i (polar pt13 gocy 2)
      pt14i (polar pt14 gocy 2)  pt10i (polar pt10 gocy 2))
(setq pt13n (inters pt pti pt13 pt13i nil) pt14n (inters pt pti pt14 pt14i nil)
      pt10n (inters pt pti pt10 pt10i nil)
      pt11n (polar pt11 (angle pt10 pt10n) (distance pt10 pt10n)))
(setq o13 (assoc 13 ds   ) o14 (assoc 14 ds   ) o10 (assoc 10 ds   ) o11 (assoc 11 ds   )
      n13 (cons  13 pt13n) n14 (cons  14 pt14n) n10 (cons  10 pt10n) n11 (cons 11 pt11n))
(if p (progn (setq ds (subst n13 o13 ds) ds (subst n14 o14 ds)))
      (progn (setq ds (subst n10 o10 ds) ds (subst n11 o11 ds))))
      (entmod ds))) (setq dem (+ dem 1)))))
;;;======================================================================
(defun C:CD () (CBD T  ))	       ; Cat moc DIM theo diem giong ;;<>
(defun C:BD () (CBD NIL))	       ; Doi moc DIM theo diem giong ;;<>

P/S: Vote Bác NĐT, Cám ơn Bác đã hướng dẫn em sửa lại code nhé!


  • 2

22665_13x13progress.gif   22665_lyky.gif   22665_13x13progress.gif


#5 Ce.truonghai

Ce.truonghai

    Edu level: li2

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

Đã gửi 29 July 2013 - 04:11 PM

Cám ơn bác NĐT và bác Lyky, để mình dùng thử cái Lisp xem còn lỗi đó ko cái. Thanks ae nhà mình nhiều.


  • 0

#6 Ce.truonghai

Ce.truonghai

    Edu level: li2

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

Đã gửi 29 July 2013 - 04:30 PM

Thanks 2 bác nhiều nhiều nha. okie rùi, lỗi đó đã sữa được. Chỉ còn như bác lyky nói thôi, khi Dim Oblique thì kết quả không theo phương đứng hoặc ngang.


  • 0

#7 lyky

lyky

    biết vẽ polygon

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

Đã gửi 30 July 2013 - 03:45 PM

1/- Cám ơn bác NĐT và bác Lyky, để mình dùng thử cái Lisp xem còn lỗi đó ko cái. Thanks ae nhà mình nhiều.
2/- Thanks 2 bác nhiều nhiều nha. okie rùi, lỗi đó đã sữa được. Chỉ còn như bác lyky nói thôi, khi Dim Oblique thì kết quả không theo phương đứng hoặc ngang.

 

Dim Oblique thì kết quả không theo phương đứng hoặc ngang: Bạn viết câu này thấy tối nghĩa lắm?!! Không hiểu ý bạn là đối với những DIM Oblique thì bạn không xài được?!! Bạn có thể nói rõ hơn?


  • 0

22665_13x13progress.gif   22665_lyky.gif   22665_13x13progress.gif


#8 matusalem

matusalem

    biết zoom

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

Đã gửi 31 July 2013 - 10:37 AM

http://www.cadviet.c...ái_sang_phi.doc

 

CẦN GIÚP ĐỞ SỬA LISP CHẠY RA TỌA ĐỘ. LISP E CHẠY RA BẢNG KÊ TỌA ĐỘ THEO THỨ TỰ TỪ TRÁI SANG PHẢI. GIỜ E MUỐN CHẠY TỪ PHẢI SANG TRÁI MÀH KO BIẾT CHỈNH SỬA THẾ NÀO. CẦN SỰ GIÚP ĐỠ CỦA CÁC ANH CHỊ 

 

ĐÂY LÀ LISP CẦN CHỈNH SỬA

http://www.cadviet.c...99_trichtdo.lsp       


  • -1

#9 nguyenbd1

nguyenbd1

    biết lệnh text

  • Members
  • PipPipPipPip
  • 276 Bài viết
Điểm đánh giá: 13 (tàm tạm)

Đã gửi 23 November 2014 - 08:13 AM

nhờ anh em kiểmtra doan mã lisp sau không hiểu sao bi lỗi

(Defun c:oi () 
(vl-load-com) 
(command "undo" "be") 
(command "ucs" "W")
(if (= droffld nil) 
(setq droffld1 2.00) 
(setq droffld1 droffld) 
(setq 
droffld (GETREAL (strcat "\nNHAP DO RONG : <" (rtos droffld1 2 2) ">")) 
(if (= droffld nil) 
(setq droffld droffld1) 
 
(if (= droffled nil) 
(setq droffled1 2.00) 
(setq droffled1 droffled) 
 
(if (= droffled nil) 
(setq droffled droffled1) 
 
 
(setq offlong (/ droffld 2))
(setq offle (+ offlong droffled))
 
(setq SS (ssget (entlast)))
(setq i 0) 
(setq N (sslength ss)) 
(while (< i N) 
(setq TEXTENT (ssname SS i)) 
(setq luubatdiem (getvar "osmode")) 
(setvar "osmode" 0) 
 
(setq diemchuan (vlax-curve-getPointAtDist TEXTENT 0)) 
(setq diemdinhhuong (vlax-curve-getPointAtDist TEXTENT 0.01)) 
(setq goc (angle diemchuan diemdinhhuong)) 
(setq diembentrai (polar diemchuan (- goc (/ pi 2)) offle)) 
(setq diembenphai (polar diemchuan (+ goc (/ pi 2)) offle)) 
 
(command ".offset" offlong textent diembentrai "") 
(command ".offset" offlong textent diembenphai "")
(command "CHANGE" "P" "" "Properties"  "Color"  "10" "" )
(command "CHANGE" "P" "" "Properties"  "lt"  "center" "" )
 
 
(setq i (1+ i)) 
(setvar "osmode" luubatdiem) 
 
(command "undo" "end") 
(princ) 
 

http://www.cadviet.c...4/122369_oi.lsp

(Defun c:oi () 
(vl-load-com) 
(command "undo" "be") 
(command "ucs" "W")
(if (= droffld nil) 
(setq droffld1 2.00) 
(setq droffld1 droffld) 
(setq 
droffld (GETREAL (strcat "\nNHAP DO RONG : <" (rtos droffld1 2 2) ">")) 
(if (= droffld nil) 
(setq droffld droffld1) 
 
(if (= droffled nil) 
(setq droffled1 2.00) 
(setq droffled1 droffled) 
 
(if (= droffled nil) 
(setq droffled droffled1) 
 
 
(setq offlong (/ droffld 2))
(setq offle (+ offlong droffled))
 
(setq SS (ssget (entlast)))
(setq i 0) 
(setq N (sslength ss)) 
(while (< i N) 
(setq TEXTENT (ssname SS i)) 
(setq luubatdiem (getvar "osmode")) 
(setvar "osmode" 0) 
 
(setq diemchuan (vlax-curve-getPointAtDist TEXTENT 0)) 
(setq diemdinhhuong (vlax-curve-getPointAtDist TEXTENT 0.01)) 
(setq goc (angle diemchuan diemdinhhuong)) 
(setq diembentrai (polar diemchuan (- goc (/ pi 2)) offle)) 
(setq diembenphai (polar diemchuan (+ goc (/ pi 2)) offle)) 
 
(command ".offset" offlong textent diembentrai "") 
(command ".offset" offlong textent diembenphai "")
(command "CHANGE" "P" "" "Properties"  "Color"  "10" "" )
(command "CHANGE" "P" "" "Properties"  "lt"  "center" "" )
 
 
(setq i (1+ i)) 
(setvar "osmode" luubatdiem) 
 
(command "undo" "end") 
(princ) 
 
(Defun c:oi () 
(vl-load-com) 
(command "undo" "be") 
(command "ucs" "W")
(if (= droffld nil) 
(setq droffld1 2.00) 
(setq droffld1 droffld) 
(setq 
droffld (GETREAL (strcat "\nNHAP DO RONG : <" (rtos droffld1 2 2) ">")) 
(if (= droffld nil) 
(setq droffld droffld1) 
 
(if (= droffled nil) 
(setq droffled1 2.00) 
(setq droffled1 droffled) 
 
(if (= droffled nil) 
(setq droffled droffled1) 
 
 
(setq offlong (/ droffld 2))
(setq offle (+ offlong droffled))
 
(setq SS (ssget (entlast)))) 
(setq i 0) 
(setq N (sslength ss)) 
(while (< i N) 
(setq TEXTENT (ssname SS i)) 
(setq luubatdiem (getvar "osmode")) 
(setvar "osmode" 0) 
 
(setq diemchuan (vlax-curve-getPointAtDist TEXTENT 0)) 
(setq diemdinhhuong (vlax-curve-getPointAtDist TEXTENT 0.01)) 
(setq goc (angle diemchuan diemdinhhuong)) 
(setq diembentrai (polar diemchuan (- goc (/ pi 2)) offle)) 
(setq diembenphai (polar diemchuan (+ goc (/ pi 2)) offle)) 
 
(command ".offset" offlong textent diembentrai "") 
(command ".offset" offlong textent diembenphai "")
(command "CHANGE" "P" "" "Properties"  "Color"  "10" "" )
(command "CHANGE" "P" "" "Properties"  "lt"  "center" "" )
 
 
(setq i (1+ i)) 
(setvar "osmode" luubatdiem) 
 
(command "undo" "end") 
(princ) 

  • 0