tanle2020 发表于 2013-6-5 13:40:50

多段线节点插块

(defun c:bpl ( / _block _ang b e i j p s )   
    (if
      (and
            (setq b (LM:ssget "\nSelect Block to Align: " '("_+.:E:S" ((0 . "INSERT")))))
            (setq s (LM:ssget "\nSelect LWPolylines: "    '(((0 . "LWPOLYLINE")))))
      )
      (progn
            (eval
                (list 'defun '_block '( p r )
                  (list 'entmake
                        (list 'list
                        ''(0 . "INSERT")
                           '(cons 10 p)
                           '(cons 50 r)
                            (list 'quote (assoc 2 (entget (ssname b 0))))
                        )
                  )
                )
            )
            (defun _ang ( e p )
                (apply 'atan (cdr (reverse (vlax-curve-getfirstderiv e p))))
            )
            (repeat (setq i (sslength s))
                (setq e (ssname s (setq i (1- i))))
                (_block (vlax-curve-getstartpoint e) (_ang e 0))
                (_block (vlax-curve-getendpoint   e) (+ pi (_ang e (vlax-curve-getendparam e))))
                (repeat (fix (setq j (1- (vlax-curve-getendparam e))))
                  (_block (setq p (vlax-curve-getpointatparam e j)) (_ang e j))
                  (_block p (+ pi (_ang e (setq j (1- j)))))
                )
            )
      )
    )
    (princ)
)

;; ssget-Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg    - selection prompt
;; params - list of ssget arguments

(defun LM:ssget ( msg params / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget params))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

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


kxdm1984 发表于 2013-6-5 13:47:46

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

tanle2020 发表于 2014-4-17 15:44:41

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

xurugen 发表于 2015-7-13 22:36:45

我也想要这个程序

xiang19751218 发表于 2015-7-14 16:00:53

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

(defun c:dj ()
   
   (setq i   0)
   (setq os    (getvar "osmode"))
   (setq pline (car (entsel)) )
   (setq ent   (entget pline))
   (setq ent1ent)
      (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)
)

水仙的错 发表于 2019-9-6 18:11:31

怎么用不了啊
页: [1]
查看完整版本: 多段线节点插块