社区 › Auto Lisp › 在铝的两端放置砌块

kareemuddin 发表于 2022-7-5 15:19:53

在铝的两端放置砌块

你好
 
有人能帮我用lisp吗？我有一个块，我想用lisp把它放在所有行的两端
 
为了更好地理解，我还附上了同样的图片
 
提前感谢

rkmcswain 发表于 2022-7-5 15:29:24

是否有任何线路共享一个公共端点？
如果是这样，你想在那里住一个或两个街区吗？

Grrr 发表于 2022-7-5 15:31:17

(defun-q C:BlockOnBothEndsOfLine nil
( '( ( f L ) (if L (apply (function f) (cons 0 L))))
   '( (i a b c / tmp)
   (and
       (setq tmp (ssname b i))
       (setq tmp (entget tmp))
       (mapcar ''( (x) (vlax-invoke c 'InsertBlock (cdr (assoc x tmp)) a 1 1 1 0)) '(10 11))
       (f (1+ i) a b c)
   )
   )
   ( '( (f L / tmp) (if (= (length L) (length (setq tmp (f L)))) tmp))
   '( ( L / tmp ) (if (and L (setq tmp (eval (car L)))) (cons tmp (f (cdr L)))) )
   '(
       ('((v) (if (and v (member '(0 . "INSERT") (entget v)))(vla-get-EffectiveName (vlax-ename->vla-object v)))) (car (entsel "\nPick the block: ")))
       (progn (princ "\nSelect the lines: ") (ssget '((0 . "LINE"))))
       ( '((f)(f (vlax-get-acad-object) (reverse '(Block ActiveLayout ActiveDocument))))
         (lambda ( o L / tmp) (if (setq tmp (car L))(f (vlax-get o tmp) (cdr L)) o ))
       )
   )
   )
)
(princ)
)

ronjonp 发表于 2022-7-5 15:39:58

另一个是露齿而笑
(defun c:foo (/ e o s tmp)
(if (and (setq e (car (entsel "\nSelect a block to copy: ")))
   (vlax-write-enabled-p (setq o (vlax-ename->vla-object e)))
   (vlax-property-available-p o 'insertionpoint)
   (setq s (ssget '((0 . "line"))))
   )
   (foreach l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
   (mapcar '(lambda (x)
       (and (not (vl-position x tmp))
              (setq tmp (cons x tmp))
              (setq o (vla-copy o))
              (vlax-put o 'insertionpoint x)
       )
       )
      (list (vlax-curve-getstartpoint l) (vlax-curve-getendpoint l))
   )
   )
)
(princ)
)
(vl-load-com)

Tharwat 发表于 2022-7-5 15:46:08

你好
就这么简单。
(defun c:test (/ pck sel int ent get bnm)
(and
   (setq pck (car (entsel "\nPick on the target block :")))
   (or (and (= (cdr (assoc 0 (setq get (entget pck)))) "INSERT")
            (null (assoc 66 get))
       )
       (alert "Invalid object. Try again.<!>")
   )
   (princ
   (strcat "\nSelect Polyline/Line(s) to place <"
             (setq bnm (vla-get-effectivename (vlax-ename->vla-object pck)))
             "> at their Endpoints :"
   )
   )
   (setq int -1
         sel (ssget '((0 . "LINE,LWPOLYLINE")))
   )
   (while (setq ent (ssname sel (setq int (1+ int))))
   (foreach p (list (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent))
       (entmake (list '(0 . "INSERT") (cons 2 bnm) (cons 10 (trans p 0 1))))
   )
   )
)
(princ)
) (vl-load-com)

hanhphuc 发表于 2022-7-5 15:50:55

OP是幸运的3种不同的方法
@grrr vla插入块方法
@ronjonp vla复制方法&删除重复项
@Tharwat entmake方法美观简单

Tharwat 发表于 2022-7-5 15:54:29

谢谢hanhphuc。
祝您今天过得愉快。

ronjonp 发表于 2022-7-5 15:59:47

 
我选择了复制方法，因此块将保留其层/比例/旋转等。。。

kareemuddin 发表于 2022-7-5 16:05:20

感谢分享Grrr

kareemuddin 发表于 2022-7-5 16:09:10

感谢分享ronjonp

查看完整版本: 在铝的两端放置砌块