5币求画线截断直线程序，要源码

hao3ren

(defun c:jd()
(setq pt1 (getpoint "\n指定第1点："))
(setq pt2 (getpoint pt1 "\n指定第2点："))
(setq pt3 (getpoint "\n指定第3点："))
(grdraw Pt1 pt2 1)
(command "line" pt1 pt2 "")
(setq tg (entLast))
(command "trim" tg "" "f" pt1 pt3 pt2 "" "")
(entdel tg)
)

半听可乐

hao3ren 发表于 2012-7-6 17:55
(defun c:jd()
(setq pt1 (getpoint "\n指定第1点："))
(setq pt2 (getpoint pt1 "\n指定第2点："))

非常感谢！但还有bug：当截断多条线时有些线截断不了，还没找到规律性~~望好人继续完善

1993063

2. (defun c:QTR ( / a ang ce cm ent obj op p1 p2 p3 p4 p5 sset)
   
3.   (defun *error* (msg)
   
4.     (setvar "osmode" a)
   
5.     (command "undo" "e")
   
6.     (setvar "CMDECHO" CM)
   
7.     (setvar "CECOLOR" CE)
   
8.     (if (and
   
9.           msg
   
10.           (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,"))
    
11.         )
    
12.       (princ)
    
13.     )
    
14.   )
    
15.   (setq a (getvar "osmode"))
    
16.   (setq CM (getvar "CMDECHO"))
    
17.   (setq CE (getvar "CECOLOR"))
    
18.   (setvar "CMDECHO" 0)
    
19.   (SETVAR "CECOLOR" "1")
    
20.   (command "undo" "be")
    
21.   (cond
    
22.     ((vl-cmdf "_.line" (setq p1 (getpoint "\n指定第一点: "))
    
23.               (setq p2 (getpoint p1 "\n指定第二点: "))
    
24.               ""
    
25.      )
    
26.       (setq ent (entlast))
    
27.       (setq p3 (getpoint "\n点击修剪边: "))
    
28.       (setq obj (vlax-ename->vla-object ent))
    
29.       (setq op (vlax-curve-getclosestpointto obj p3))
    
30.       (setq ang (angle op p3))
    
31.       (setq p4 (polar p1 ang 1))
    
32.       (setq p5 (polar p2 ang 1))
    
33.       (setq sset (ssget "_f" (list p1 p2)))
    
34.       (command "_.trim" sset "" "f" p4 p5 "" "")
    
35.       (command "_.erase" ent "")
    
36.     )
    
37.   )
    
38.   (setvar "osmode" a)
    
39.   (setvar "CMDECHO" CM)
    
40.   (setvar "CECOLOR" CE)
    
41.   (command "undo" "e")
    
42.   (princ)
    
43. )
    

(defun c:QTR ( / a ang ce cm ent obj op p1 p2 p3 p4 p5 sset)<br />   (defun *error* (msg)<br />     (setvar "osmode" a)<br />     (command "undo" "e")<br />     (setvar "CMDECHO" CM)<br />     (setvar "CECOLOR" CE)<br />     (if (and<br />           msg<br />           (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,"))<br />         )<br />       (princ)<br />     )<br />   )<br />   (setq a (getvar "osmode"))<br />   (setq CM (getvar "CMDECHO"))<br />   (setq CE (getvar "CECOLOR"))<br />   (setvar "CMDECHO" 0)<br />   (SETVAR "CECOLOR" "1")<br />   (command "undo" "be")<br />   (cond<br />     ((vl-cmdf "_.line" (setq p1 (getpoint "\n指定第一点: "))<br />               (setq p2 (getpoint p1 "\n指定第二点: "))<br />               ""<br />      )<br />       (setq ent (entlast))<br />       (setq p3 (getpoint "\n点击修剪边: "))<br />       (setq obj (vlax-ename->vla-object ent))<br />       (setq op (vlax-curve-getclosestpointto obj p3))<br />       (setq ang (angle op p3))<br />       (setq p4 (polar p1 ang 1))<br />       (setq p5 (polar p2 ang 1))<br />       (setq sset (ssget "_f" (list p1 p2)))<br />       (command "_.trim" sset "" "f" p4 p5 "" "")<br />       (command "_.erase" ent "")<br />     )<br />   )<br />   (setvar "osmode" a)<br />   (setvar "CMDECHO" CM)<br />   (setvar "CECOLOR" CE)<br />   (command "undo" "e")<br />   (princ)<br /> )<br />

半听可乐

Gu_xl 发表于 2012-7-7 00:54
[/post]

G版出马，什么都是浮云，哈哈，对我来说功能非常完美了，谢谢！

半听可乐

Gu_xl 发表于 2012-7-6 15:57
[/post]

奇怪，我的回复怎么看不见~~这么好的程序，我得再三感谢G版了，非常完美，感谢感谢！

longer1000

G版出手，非常感谢

longer1000

Gu_xl 发表于 2012-7-6 15:57
[/post]

测试在确定第二点时，不能捕捉。

yjr111

Gu_xl 发表于 2012-7-6 15:57
[/post]

G版出手，不同凡响，顶！

小心

学学，看看，长见识

kexiya123

G大侠的程序不错，只是捕捉第二点时最好还是有交点、垂足、最近点之类的带选择性更好。你的F8,F3选择不太适用。