Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Nhờ các bác viết lisp vẽ đường dóng trắc ngang


  • Please log in to reply
11 replies to this topic

#1 satthuvothan

satthuvothan

    biết pan

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

Đã gửi 13 August 2011 - 09:10 AM

Em muốn nhờ các bác viết giùm 1 lisp khi chọn đoạn thẳng L1 và L2 thì lisp sẽ tự động vẽ đường thẳng D1, D2 vuông góc với L2, có điểm xuất phát từ điểm đầu và điểm cuối của L1.
Em cảm ơn các bác nhiều.

Hình đã gửi
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 August 2011 - 09:28 AM

Của bạn đây. CHo phép bạn chọn 1 đường chuẩn L2 và nhiều đường cần kẻ gióng L1 :
(defun c:kdg(/ dxf ST:Ss->ListEnt ST:Entmake-Line ssLine curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")
;;;;===== Local Functions =======
(defun dxf (code ent)(cdr (assoc code (entget ent))))
(defun ST:Ss->ListEnt (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l))))
(defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1))))

;;;;======= Start Here =========
(setq curve-obj (vlax-ename->vla-object (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng chu\U+1EA9n (L2) :"))))
(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+01B0\U+1EDDng c\U+1EA7n v\U+1EBD \U+0111\U+01B0\U+1EDDng gi\U+00F3ng (L1) : ")
(setq ssLine (ST:Ss->ListEnt(ssget (list (cons 0 "LINE")))))
(foreach Line ssLine
(ST:Entmake-Line (dxf 10 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 10 Line)))
(ST:Entmake-Line (dxf 11 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 11 Line)))
))

  • 2

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


#3 satthuvothan

satthuvothan

    biết pan

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

Đã gửi 13 August 2011 - 11:06 AM

Của bạn đây. CHo phép bạn chọn 1 đường chuẩn L2 và nhiều đường cần kẻ gióng L1 :

(defun c:kdg(/ dxf ST:Ss->ListEnt ST:Entmake-Line ssLine curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")
;;;;===== Local Functions =======
(defun dxf (code ent)(cdr (assoc code (entget ent))))
(defun ST:Ss->ListEnt (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l))))
(defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1))))

;;;;======= Start Here =========
(setq curve-obj (vlax-ename->vla-object (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng chu\U+1EA9n (L2) :"))))
(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+01B0\U+1EDDng c\U+1EA7n v\U+1EBD \U+0111\U+01B0\U+1EDDng gi\U+00F3ng (L1) : ")
(setq ssLine (ST:Ss->ListEnt(ssget (list (cons 0 "LINE")))))
(foreach Line ssLine
(ST:Entmake-Line (dxf 10 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 10 Line)))
(ST:Entmake-Line (dxf 11 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 11 Line)))
))


Cảm ơn bác nhìu! Em làm được zùi
  • 1

#4 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 14 August 2011 - 10:07 PM

Của bạn đây. CHo phép bạn chọn 1 đường chuẩn L2 và nhiều đường cần kẻ gióng L1 :

(defun c:kdg(/ dxf ST:Ss->ListEnt ST:Entmake-Line ssLine curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")
;;;;===== Local Functions =======
(defun dxf (code ent)(cdr (assoc code (entget ent))))
(defun ST:Ss->ListEnt (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l))))
(defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1))))

;;;;======= Start Here =========
(setq curve-obj (vlax-ename->vla-object (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng chu\U+1EA9n (L2) :"))))
(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+01B0\U+1EDDng c\U+1EA7n v\U+1EBD \U+0111\U+01B0\U+1EDDng gi\U+00F3ng (L1) : ")
(setq ssLine (ST:Ss->ListEnt(ssget (list (cons 0 "LINE")))))
(foreach Line ssLine
(ST:Entmake-Line (dxf 10 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 10 Line)))
(ST:Entmake-Line (dxf 11 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 11 Line)))
))

Ketxu có thể code lại lisp trên theo ý của mình như file sau được không: My link
Tương tự lisp trên nhưng đường L1 là Polyline, lisp sẽ vẽ đường gióng tại các điểm của polyline tới đường L2!
Thân !
  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 August 2011 - 10:29 PM

@NNS : nhiều lần bạn gửi link và mình+ mọi người phải ngồi chờ down file trên host đó, là bạn bạn có ngồi chờ down để code không ? :wacko:
Quick code, yêu cầu Express :
;============= Require Express =============
(defun c:kdg(/ ST:Entmake-Line Line curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")
;;;;===== Local Functions ==================
(defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1))))
;;============= Start Rountine =============
(setq curve-obj (car (entsel "\nCh\U+1ECDn PLine :"))
Line (vlax-ename->vla-object (car(entsel "\nCh\U+1ECDn PLine \U+0111\U+00EDch : "))))
(foreach vertex (acet-geom-vertex-list curve-obj)
(ST:Entmake-Line vertex (vlax-curve-getClosestPointTo Line vertex))
))

  • 1

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


#6 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 14 August 2011 - 10:55 PM

Thank Ketxu nhiều lắm :D. Nếu mình muốn bỏ không vẽ đường dóng tại 2 điểm ngoài cùng của Polyline thì xử lý ntn ?
Thân ! (Bạn code nhanh thật :) )
  • 0

#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 August 2011 - 11:07 PM

Thank Ketxu nhiều lắm :D. Nếu mình muốn bỏ không vẽ đường dóng tại 2 điểm ngoài cùng của Polyline thì xử lý ntn ?
Thân ! (Bạn code nhanh thật :) )

Thì loại điểm đầu và điểm cuối ra khỏi list :
(defun c:kdg(/ ST:Entmake-Line Line curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")
;;;;===== Local Functions ==================
(defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1))))
;;============= Start Rountine =============
(setq curve-obj (car (entsel "\nCh\U+1ECDn PLine :"))
Line (vlax-ename->vla-object (car(entsel "\nCh\U+1ECDn PLine \U+0111\U+00EDch : "))))
(foreach vertex (cdr(reverse (cdr(acet-geom-vertex-list curve-obj))))
(ST:Entmake-Line vertex (vlax-curve-getClosestPointTo Line vertex))
))

  • 1

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


#8 vetgo

vetgo

    biết vẽ polygon

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

Đã gửi 23 August 2011 - 03:01 PM

Cảm ơn bác nhìu! Em làm được zùi

Của em nó lại rơi vào trường hợp có nhiều Polyline nằm kề nhau, h em muốn chọn nhiều Polyline 1 lúc giống như chọn nhiều doạn thẳng như Code thứ nhất mà bác gửi Ketxu gửi ấy. Mong bác ra tay...
  • 0
Nếu nội dung post là có ích, xin tick + để thăng hàm lên lương...

#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 August 2011 - 09:03 PM

Bạn sửa lại như thế này, dùng cho L1 là Line,Pline, Sline,*Line :

(defun c:kdg(/ ST:Ss->ListEnt ST:Entmake-Line ssLine curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")

(defun ST:Ss->ListEnt (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l))))
(defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1))))

;;;;======= Start Here =========
(setq curve-obj (vlax-ename->vla-object (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng chu\U+1EA9n (L2) :"))))
(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+01B0\U+1EDDng c\U+1EA7n v\U+1EBD \U+0111\U+01B0\U+1EDDng gi\U+00F3ng (L1) : ")
(setq ssLine (ST:Ss->ListEnt(ssget (list (cons 0 "*LINE")))))
(foreach Line ssLine
(ST:Entmake-Line (setq tmp (vlax-curve-getStartPoint Line) )(vlax-curve-getClosestPointTo curve-obj tmp))
(ST:Entmake-Line (setq tmp (vlax-curve-getEndPoint Line)) (vlax-curve-getClosestPointTo curve-obj tmp))
))

  • 1

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


#10 thanhhuyen7789

thanhhuyen7789

    biết pan

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

Đã gửi 23 August 2011 - 10:48 PM

Nhờ các bac giúp em với. cái list của em vừa mới up lên diễn đàn đây nó chỉ chạy được cao độ thôi mà không thể hiệu chỉnh được chiều cao tex thei ý muốn của từng file nên các bác có thê làm giúp em cái list mà có thể định dạng chiều cao chữ theo từng tỷ lệ của bản vẽ được không, và nếu có thể kèm theo texl là blook thuộc tính Att hay gì đó, về vấn đề list thì em quả là gà mờ các bác ạ.
  • 0

#11 thanhhuyen7789

thanhhuyen7789

    biết pan

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

Đã gửi 23 August 2011 - 10:49 PM

Nhờ các bac giúp em với. cái list của em vừa mới up lên diễn đàn đây nó chỉ chạy được cao độ thôi mà không thể hiệu chỉnh được chiều cao tex thei ý muốn của từng file nên các bác có thê làm giúp em cái list mà có thể định dạng chiều cao chữ theo từng tỷ lệ của bản vẽ được không, và nếu có thể kèm theo texl là blook thuộc tính Att hay gì đó, về vấn đề list thì em quả là gà mờ các bác ạ.
Bình chọn bài viết này 0
------------------------------
(DEFUN C:DTL() ;(Chuong trinh doi ty le ban ve);
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
------------------------------

(defun c:DT1()
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(if (= vol nil) (progn
(setq vol (getreal "\nAll Quanttities(1) or Half(2): "))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 3000 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ (/ dtl He_so2) vol))
; (setq pt2 (getpoint "\nChon diem ghi ra : "))
; (command "text" "J" "M" pt2 2 0 (rtos dtl 2 2))
; (setq pt3 (rtos dtl 2 2))
; (while (null (setq pt5 (entsel "\nChon so ghi can sua:"))))
; (setq dt (entget (car pt5)))
; (setq loai (cdr (assoc 0 dt)))
; (if (= dtl "TEXT")

(progn
(setq pt3 (rtos dtl 2 2))
(setq pt5 (entsel "\nChon so ghi can sua :"))
(initget 0)
(if (null pt5)

(progn
(setq pt6 (getpoint "\nChon diem de the ghi : " ))
(command "text" "J" "M" pt6 2 "0" pt3)
)
(progn
(setq dt (entget (car pt5)))
(setq loai (cdr (assoc 0 dt)))
(command ".change" pt5 "" "" "" "" (cdr (assoc 40 dt)) "" pt3)
(command ".change" pt5 "" "P" "C" "7" "")
)
)
)
; (print)
; (prompt (strcat "\nTotal area : " (rtos dTy_le 2 4)))
; (print)
; (setq pt2 (getpoint "\nPoint to write: "))
; (command "text" pt2 "" "0" (rtos dtl 2 2))
);defun
------------------------------
(DEFUN C:TCD() ;(Chuong trinh tim cao do);
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(command "_layer" "new" "Text" "color" "white" "Text" "")
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq cu (getvar "OSMODE"))
(Command "-osnap" "INT")
(Command "UCS" "W")
; (initget 129 "Y N")
; (setq dk (getkword "\nCo lay cao do o vi tri bat ky?<Y/N>:"))
; (if (= dk "Y")
(progn
(setq OO1 (getpoint "\nPick diem lay cao do: "))
(setq Xt (car OO1)
Yt (cadr OO1)
XOY (list Xt Yt)
))
; (progn
; (setq OO (getpoint "\nPick tim duong thiet ke : "))
; (setq
; XOY (List (car OO) (- (cadr OO) (* 0.25 He_so)))
; Xt (car XOY)
; Yt (cadr XOY)
; ))
; )
(setvar "OSMODE" 0)
(Command "UCS" "O" XOY)
(setq text (car (nentsel "\nChon cao do TKe :")))
(Command "-osnap" "INT,END")
(setq k (getpoint "\nChon diem tim cao do :"))
(while (/= text nil)
(progn
(setq st2 (entget text)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st2))) ;;Lay noi dung text:ma DXF=1
(setq cdotim (atof st)
tim (getpoint "\ndiem dat :")
tim (list (car tim) (+ (cadr tim) 0.85))
Xt (/ (car k) he_so)
Yt (+ (/ (cadr k) he_so) cdotim)
gtr (rtos yt 2 2)
; h 8.0
h (* he_so 0.2)
)
(Command "_layer" "set" "text" "")
; (Command "text" tim h "0" gtr "")
; (command "_layer" "set" "0" "")
(Command "-osnap" "NONE")
(Command "text" "J" "ML" tim h "0" gtr "")
(princ "\n Khoang cach tu Tim: ")
(prin1 Xt)
(Command "-osnap" "INT,END")
(setq k (getpoint "\nChon diem tim cao do tiep theo :" ))
(princ)
))
(setvar "OSMODE" cu)
(princ)
)
------------------------************-------------------
(DEFUN C:KCa() ;(Chuong trinh viet K/C le);
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq cu (getvar "OSMODE"))
(Command "-osnap" "MID")
(setq Chan (getpoint "\nChon diem dat TEXT :"))
(setq Ych (- (cadr Chan) 0.5) )
(Command "-osnap" "END")
(setq A1 (getpoint "\nChon diem thu nhat :")
A2 (getpoint "\nChon diem thu 2 :")
ht 2.0
; ht (/ he_so 2.5)
)
(While (/= A2 nil)
(progn
(setq Xa1 (car A1)
Xa2 (car A2)
Tb (/ (+ Xa1 Xa2) 2)
Dat (list Tb Ych)
DISS (/ (abs (- Xa1 Xa2)) He_so)
DIS (rtos DISS 2 2)
)
----------
(if (< DISS 1)
(setq Ang 90)
(setq Ang 0)
)
-----------
(Command "-osnap" "")
(Command "text" "J" "M" Dat ht Ang DIS)
)
(Command "-osnap" "END")
(setq A1 (getpoint "\nChon diem thu nhat :")
A2 (getpoint "\nChon diem thu 2 :"))
)
(setvar "OSMODE" cu)
(princ)
)
---------------------********-----------------------
(defun C:SCC () ;Chuong trinh sua lai do doc mat duong
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(setq st1 (car (entsel "\nPick cao do thu nhat : "))) ;;Lay ma doi tuong
(setq st1 (entget st1)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st1))) ;;Lay noi dung text:ma DXF=1
(setq a1 (atof st))
(prin1 a1)
(setq st2 (car (entsel "\nPick cao do thu hai: "))) ;;Lay ma doi tuong
(setq st2 (entget st2)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st2))) ;;Lay noi dung text:ma DXF=1
(setq a2 (atof st))
(prin1 a2)
(setq kc (atof (cdr (assoc 1 (entget (car (entsel "\nPick K/C :")))))))
(print kc)
(setq sc (* 100 (/ (- a1 a2) kc))
sc (rtos sc 2 2)
sc (strcat sc "%")
)
(setq en (car (entsel "\nThay cho do doc ngang : ")))
(setq elst (entget en))
(setq elst (subst (cons 1 (strcat " " sc)) (assoc 1 elst) elst))
(setq elst (append elst '((62 . 3))));7 trang
(prin1 elst)
(entmod elst)
)
-----------------------***********----------------------
(Defun C:ddan() ;CT VIET DUONG DAN CUA BAN VE
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq last (getvar "OSMODE"))
(Command "-osnap" "END")
(if (= TEN nil) (setq TEN (getstring "\nMay cua ai: ")))
(setq NAME (getvar "dwgname")
PATH (getvar "dwgprefix")
POINT (getpoint "\nPick Bottum_Letf :")
POINT (list (- (car POINT) 3) (cadr POINT))
ND (strcat "TV8-TK2-" TEN " FILE: " PATH NAME)
)
(Command "_layer" "set" "0" "")
(Command "-osnap" "NONE")
(Command "Text" POINT "2.0" "90" ND)
(setvar "OSMODE" last)
(princ)
)
------------------------------------------------

(DEFUN XD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nSelect vertical dimension(s) extensions to be aligned")
(SETQ SET (SSGET))
(PROMPT"\nSelect new extension position")
(SETQ P1 (GETPOINT))
(SETQ X3 (CAR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 X3 (CADR M13) (CADDR M13)))
(SETQ P14 (LIST 14 X3 (CADR M14) (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(PRINC)
)
(DEFUN C:XD () (XD) )
(DEFUN C:XX () (XD) )
(DEFUN C:SDD () (XD) )
--------------------------------------
(DEFUN YD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nSelect dimension(s) to be aligned")
(SETQ SET (SSGET))
(PROMPT"\nSelect new dimension position")
(SETQ P1 (GETPOINT))
(SETQ Y3 (CADR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 (CAR M13) Y3 (CADDR M13)))
(SETQ T13 (CDR P13))
(SETQ P14 (LIST 14 (CAR M14) Y3 (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
(DEFUN C:YD () (YD) )
(DEFUN C:YY () (YD) )
(DEFUN C:SDN () (YD) )
-------------------------------------
(DEFUN YD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon dim can cat")
(SETQ SET (SSGET))
(PROMPT"\nChon vi tri cat")
(SETQ P1 (GETPOINT))
(SETQ Y3 (CADR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 (CAR M13) Y3 (CADDR M13)))
(SETQ T13 (CDR P13))
(SETQ P14 (LIST 14 (CAR M14) Y3 (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
(DEFUN C:YD () (YD) )
(DEFUN C:ww () (YD) )
(DEFUN C:SDN () (YD) )
------------------------
(load "C:/acad.lsp")
(load "C:/catdoc.lsp")
(load "C:/loadhet.lsp")
  • 0

#12 whoang

whoang

    Chưa sử dụng CAD

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

Đã gửi 30 April 2016 - 10:12 AM

Bạn sửa lại như thế này, dùng cho L1 là Line,Pline, Sline,*Line :
 

(defun c:kdg(/ ST:Ss->ListEnt ST:Entmake-Line ssLine curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")

(defun ST:Ss->ListEnt (ss / n e l)
  (setq n (sslength ss))
  (while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l))))
 (defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1)))) 
  
;;;;======= Start Here =========
(setq curve-obj (vlax-ename->vla-object (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng chu\U+1EA9n (L2) :"))))
(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+01B0\U+1EDDng c\U+1EA7n v\U+1EBD \U+0111\U+01B0\U+1EDDng gi\U+00F3ng (L1) : ")
(setq ssLine (ST:Ss->ListEnt(ssget (list (cons 0 "*LINE")))))
(foreach Line ssLine
		(ST:Entmake-Line (setq tmp (vlax-curve-getStartPoint Line) )(vlax-curve-getClosestPointTo curve-obj tmp))
		(ST:Entmake-Line (setq tmp (vlax-curve-getEndPoint Line)) (vlax-curve-getClosestPointTo curve-obj tmp))
))





Nhờ bác ketxu bổ sung thêm các bước sau được không ạ: 
1.chọn text cao độ mặt so sánh 
2.tính toán rồi điền text cao độ (của các điểm trên PL) ở chân đường dóng.

  • 0