刷直线为引线（Z版提供）

lucas_3333

ZZXXQQ 发表于 2014-3-10 19:55
PLINE?直接炸开不就是直线了。

谢谢Z版，但是不能选择箭头在直线的哪一侧了

davide888

顶了先         

恕放之生命

谢谢分享。　

ZZXXQQ

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

hooboxu

不错。赞一个

dabingrain

2. ;线变箭头 明经 ZZXXQQ 2014.8.6
   
3. (defun c:tt ()
   
4.   (setvar "CMDECHO" 0)
   
5.   (if (setq ss (ssget ":S" '((0 . "LINE,LWPOLYLINE"))))
   
6.     (progn
   
7.       (repeat (setq i (sslength ss))
   
8.         (setq i (1- i))
   
9.         (setq en (ssname ss i))
   
10.         (redraw  en 3)
    
11.         (setq ent (entget en))
    
12.         (if (= (cdr(assoc 0 ent)) "LINE")
    
13.           (progn
    
14.             (setq
    
15.               p1 (cdr(assoc 10 ent))
    
16.               p2 (cdr(assoc 11 ent))
    
17.             )
    
18.             (if (setq fx (getpoint "\n端点: "))
    
19.               (if (< (distance fx p1) (distance fx p2))
    
20.                 (command "_.LEADER" p1 p2 "" "" "N")
    
21.                 (command "_.LEADER" p2 p1 "" "" "N")
    
22.               )
    
23.             )
    
24.           )
    
25.           (progn
    
26.             (setq plst (list))
    
27.             (foreach x ent
    
28.               (if (= (car x) 10)
    
29.                 (setq plst (cons (cdr x) plst))
    
30.               )
    
31.             )
    
32.             (if (setq fx (getpoint "\n端点: "))
    
33.               (if (< (distance fx (last plst)) (distance fx (car plst)))
    
34.                 (setq plst (reverse plst))
    
35.               )
    
36.             )
    
37.             (setq p1 (car plst))
    
38.             (command "_.LEADER" P1)
    
39.             (mapcar '(lambda (a) (command a)) (cdr plst))
    
40.             (command "" "" "N")
    
41.           )
    
42.          
    
43.         )
    
44.         (redraw  en 4)
    
45.       )
    
46.       (command "_.ERASE" ss "")
    
47.     )
    
48.    
    
49.   )
    
50.   (setvar "CMDECHO" 1)
    
51.   (princ)
    
52. )

;线变箭头 明经 ZZXXQQ 2014.8.6<br /> (defun c:tt ()<br />   (setvar "CMDECHO" 0)<br />   (if (setq ss (ssget ":S" '((0 . "LINE,LWPOLYLINE")))) <br />     (progn<br />       (repeat (setq i (sslength ss))<br />         (setq i (1- i))<br />         (setq en (ssname ss i))<br />         (redraw  en 3)<br />         (setq ent (entget en))<br />         (if (= (cdr(assoc 0 ent)) "LINE") <br />           (progn<br />             (setq <br />               p1 (cdr(assoc 10 ent))<br />               p2 (cdr(assoc 11 ent))<br />             )<br />             (if (setq fx (getpoint "\n端点: "))<br />               (if (< (distance fx p1) (distance fx p2))<br />                 (command "_.LEADER" p1 p2 "" "" "N")<br />                 (command "_.LEADER" p2 p1 "" "" "N")<br />               )<br />             )<br />           ) <br />           (progn<br />             (setq plst (list))<br />             (foreach x ent <br />               (if (= (car x) 10) <br />                 (setq plst (cons (cdr x) plst))<br />               )<br />             )<br />             (if (setq fx (getpoint "\n端点: "))<br />               (if (< (distance fx (last plst)) (distance fx (car plst)))<br />                 (setq plst (reverse plst))<br />               )<br />             )<br />             (setq p1 (car plst))<br />             (command "_.LEADER" P1)<br />             (mapcar '(lambda (a) (command a)) (cdr plst))<br />             (command "" "" "N")<br />           )<br />           <br />         )<br />         (redraw  en 4)<br />       )<br />       (command "_.ERASE" ss "")<br />     )<br />     <br />   )<br />   (setvar "CMDECHO" 1)<br />   (princ)<br /> )

疯球

谢谢分享！！！！

young-yi

w245272914

dabingrain 发表于 2016-6-1 10:52

能不用端點去判斷箭頭就好了，直線自由點在屏幕上，離那個端點近自由判斷箭頭在那邊，這樣操作比較爽