多段线节点插块

tanle2020

2. (defun c:bpl ( / _block _ang b e i j p s )   
   
3.     (if
   
4.         (and
   
5.             (setq b (LM:ssget "\nSelect Block to Align: " '("_+.:E:S" ((0 . "INSERT")))))
   
6.             (setq s (LM:ssget "\nSelect LWPolylines: "    '(((0 . "LWPOLYLINE")))))
   
7.         )
   
8.         (progn
   
9.             (eval
   
10.                 (list 'defun '_block '( p r )
    
11.                     (list 'entmake
    
12.                         (list 'list
    
13.                           ''(0 . "INSERT")
    
14.                            '(cons 10 p)
    
15.                            '(cons 50 r)
    
16.                             (list 'quote (assoc 2 (entget (ssname b 0))))
    
17.                         )
    
18.                     )
    
19.                 )
    
20.             )
    
21.             (defun _ang ( e p )
    
22.                 (apply 'atan (cdr (reverse (vlax-curve-getfirstderiv e p))))
    
23.             )
    
24.             (repeat (setq i (sslength s))
    
25.                 (setq e (ssname s (setq i (1- i))))
    
26.                 (_block (vlax-curve-getstartpoint e) (_ang e 0))
    
27.                 (_block (vlax-curve-getendpoint   e) (+ pi (_ang e (vlax-curve-getendparam e))))
    
28.                 (repeat (fix (setq j (1- (vlax-curve-getendparam e))))
    
29.                     (_block (setq p (vlax-curve-getpointatparam e j)) (_ang e j))
    
30.                     (_block p (+ pi (_ang e (setq j (1- j)))))
    
31.                 )
    
32.             )
    
33.         )
    
34.     )
    
35.     (princ)
    
36. )
    
37. 
    
38. ;; ssget  -  Lee Mac
    
39. ;; A wrapper for the ssget function to permit the use of a custom selection prompt
    
40. ;;
    
41. ;; Arguments:
    
42. ;; msg    - selection prompt
    
43. ;; params - list of ssget arguments
    
44. 
    
45. (defun LM:ssget ( msg params / sel )
    
46.     (princ msg)
    
47.     (setvar 'nomutt 1)
    
48.     (setq sel (vl-catch-all-apply 'ssget params))
    
49.     (setvar 'nomutt 0)
    
50.     (if (not (vl-catch-all-error-p sel)) sel)
    
51. )
    
52. 
    
53. (vl-load-com)
    
54. (princ)

(defun c:bpl ( / _block _ang b e i j p s )    <br />     (if<br />         (and<br />             (setq b (LM:ssget "\nSelect Block to Align: " '("_+.:E:S" ((0 . "INSERT")))))<br />             (setq s (LM:ssget "\nSelect LWPolylines: "    '(((0 . "LWPOLYLINE")))))<br />         )<br />         (progn<br />             (eval<br />                 (list 'defun '_block '( p r )<br />                     (list 'entmake<br />                         (list 'list<br />                           ''(0 . "INSERT")<br />                            '(cons 10 p)<br />                            '(cons 50 r)<br />                             (list 'quote (assoc 2 (entget (ssname b 0))))<br />                         )<br />                     )<br />                 )<br />             )<br />             (defun _ang ( e p )<br />                 (apply 'atan (cdr (reverse (vlax-curve-getfirstderiv e p))))<br />             )<br />             (repeat (setq i (sslength s))<br />                 (setq e (ssname s (setq i (1- i))))<br />                 (_block (vlax-curve-getstartpoint e) (_ang e 0))<br />                 (_block (vlax-curve-getendpoint   e) (+ pi (_ang e (vlax-curve-getendparam e))))<br />                 (repeat (fix (setq j (1- (vlax-curve-getendparam e))))<br />                     (_block (setq p (vlax-curve-getpointatparam e j)) (_ang e j))<br />                     (_block p (+ pi (_ang e (setq j (1- j)))))<br />                 )<br />             )<br />         )<br />     )<br />     (princ)<br /> )<br /> <br /> ;; ssget  -  Lee Mac<br /> ;; A wrapper for the ssget function to permit the use of a custom selection prompt<br /> ;;<br /> ;; Arguments:<br /> ;; msg    - selection prompt<br /> ;; params - list of ssget arguments<br /> <br /> (defun LM:ssget ( msg params / sel )<br />     (princ msg)<br />     (setvar 'nomutt 1)<br />     (setq sel (vl-catch-all-apply 'ssget params))<br />     (setvar 'nomutt 0)<br />     (if (not (vl-catch-all-error-p sel)) sel)<br /> )<br /> <br /> (vl-load-com)<br /> (princ)

上面代码为多段线节点插块，但是效果不是我要的，下图是我想要的效果，求帮忙改下代码。

kxdm1984

哪位大神知道怎么把一条多义线各段的x、y方向的增量读出来的lisp程序吗

tanle2020

工作中常用到，顶起！求解决

xurugen

我也想要这个程序

xiang19751218

此程序是明经下载的，原作者是谁记不清了

(defun c:dj ()
   
     (setq i     0)
     (setq os    (getvar "osmode"))
     (setq pline (car (entsel)) )
     (setq ent   (entget pline))
     (setq ent1  ent)
      (repeat  (cdr(assoc 90 ent) )   
          (setvar "osmode" 0)
          (setq p0   (cdr (assoc 10 ent1) )
                ent1 (vl-remove (assoc 10 ent1)  ent1)
          )
          (ins)
          (setq i (1+ i))   
     )  
     (princ) (setvar "osmode" os)
)

(defun ins ()
   (COMMAND "-insert"  "sk" p0 "1" "1" "0" );sk为块名
   (princ)
)

水仙的错

怎么用不了啊