Đến nội dung


Hình ảnh
- - - - -

[Yêu Cầu] Nhờ Vả Sửa Lisp, Thêm Tùy Chọn Cài Đặt Các Thông Số!


  • Please log in to reply
1 reply to this topic

#1 ryback

ryback

    biết zoom

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

Đã gửi 07 October 2016 - 05:52 PM

Xin chào anh em chú bác trên diễn đàn, giờ mình có vấn đề này đang cần ạ.

Chả là mình có cái lisp vẽ taluy khá là ưng ý của 1 bạn nào đó trên diễn đàn rồi, nhưng giờ mình có 1 yêu cầu nho nhỏ như thế này. Đó là các đường ta luy này có các thông số như chiều dài các đường, khoảng cách các đường, số đường ngắn/số đường dài, ... Nhưng mình đặt cố định trong lisp rồi, nên muốn sửa thì phải sửa trong file lsp, cũng có một chút bất tiện. Giờ mình muốn thêm một lệnh cài đặt các thông số này, xong sau đó khi thực hiện lệnh vẽ taluy thì sẽ dùng các thông số đó để vẽ, nếu muốn thay đổi thì thực hiện lại lệnh cài đặt trên.

Mong các cao nhân trên diễn đàn giúp đỡ mình một chút ạ, hehe!

(defun c:xtl (/)
  (setvar "CMDECHO" 0)
  (setq osmode (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "unitmode" 0)
  (setvar "dimzin" 0)
  (setvar "blipmode" 0)
  (setvar "aunits" 0)
  (setvar "angbase" (/ pi 2))
  (setvar "angdir" 1)
  (setq layerp (getvar "clayer"))
  (command "-color" "Bylayer")
  (if (not (tblsearch "layer" "BATTER"))
    (command "-layer" "n" "BATTER" "color" "8" "BATTER" "s" "BATTER" \n)
    (command "-layer" "s" "BATTER" \n)
  )

  (if (not lint)
    (setq lint 10.0)
  )
  ;(setq    int (getdist (strcat "\nNhap khoang cach chia taluy <"
                 ;(rtos lint 2 3)
                 ;">: "
             
        
  
  ;(if int
    ;(setq lint int)
    ;(setq int lint)
  
;(neu muon nhap bang tay khoang cach giua cac duong thi kich hoat cac dong lenh o tren)
  (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 "\nChon doi tuong can rai taluy : "))
    (command "undo" "group")
    (redraw (car refent) 3)
    (initget 1 "daO daP")
    (setq
      reply (getkword "\nChon kieu taluy Nen Da[O] hay Nen Da[P]: ")
    )
    (print "\n")
    (print "Chon cac doi tuong can batter :")
    (setq s (ssget))
    (command "measure" refent "b" "tadtick" "y" 1) ;so cuoi la khoang cach giua cac duong (neu muon nhap bang tay thi thay = int, va kich hoat cac dong lenh o tren)
    (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 "daP")
          (if (= (rem cn 2) 0) ;(so sau chu cn - 1) la so duong ngan
        ;(command "line" pt1 pt2 "")
        (command
          "line"
          pt1
          (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 1.25)) ;so cuoi la ty le giua duong duong dai va full (1/n)
          ""
        )
        (command
          "line"
          pt1
          (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.5)) ;so cuoi la ty le giua duong ngan va full (1/n)
          ""
        )
          )
          (if (= (rem cn 2) 0) ;(so sau chu cn - 1) la so duong ngan
        ;(command "line" pt2 pt1 "")
        (command
          "line"
          pt2
          (polar pt2 (angle pt2 pt1) (/ (distance pt2 pt1) 1.25)) ;so cuoi la ty le giua duong dai va full (1/n)
          ""
        )
        (command
          "line"
          pt2
          (polar pt2 (angle pt2 pt1) (/ (distance pt2 pt1) 2.5)) ;so cuoi la ty le giua duong ngan va full (1/n)
          ""
        )
          )
        )
      )
      (setq cn (1+ cn))
    )
      )
    )
    (command "undo" "en")
  )
  (setvar "blipmode" 0)
  (setvar "osmode" osmode)
  (setvar "clayer" layerp)    
  (princ)
)

  • -1

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 07 October 2016 - 07:03 PM

Nếu biết chút ít về lisp CAD thì bạn chuyển tất cả các biến cần setting thành biến toàn cục, và viết lệnh mới chỉ setq các biến này.
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC