社区 › Auto Lisp › 阻止所有点

teknomatika 发表于 2022-7-6 08:48:46

阻止所有点

我需要一个例程，允许您在图形中现有的所有点中输入特定块。有人记得这个问题已经在这里讨论过了吗？

teknomatika 发表于 2022-7-6 08:58:06

嗯，我找到了地方。这是某人感兴趣的案例的代码。
;insert a block on points
(defun c:b2p (/ #cmdecho blkname ss scale idx n entname edata)
(command "undo" "begin")
(setq #cmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq blkname (getstring "\n Block name : "))
(if (= blkname "")(setq blkname "Block"))
(setq ss (ssget '((0 . "POINT"))))
(if ss
(progn
(setq scale (getreal "\n Block Scale <1>: "))
(if (= scale nil)(setq scale 1))
(setq idx 0)
(setq n (sslength ss))
(repeat n
(setq entname (ssname ss idx))
(setq edata (entget entname))
(entmake (list (cons 0 "INSERT")
(cons 2 blkname)
(assoc 10 edata)
(assoc 8 edata)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
(cons 50 0)
)
)
(entdel entname)
(setq idx (1+ idx))
)
(princ "\n\n Done!")
)
(princ "\n Not point(s) selected(s)!")
)
(setvar "cmdecho" #cmdecho)
(command "undo" "end")
(princ))

Tharwat 发表于 2022-7-6 09:04:56

我的方法。。。
 

(defun c:TesT (/ Blkname ss)
;; Tharwat 12. Oct. 2011 ;;
(if (and (setq Blkname (getstring T "\n Name of Block :"))
          (tblsearch "BLOCK" Blkname)
          (setq ss (ssget '((0 . "POINT"))))
   )
   ((lambda (i / ss1 e in x)
      (while
      (setq ss1 (ssname ss (setq i (1+ i))))
         (setq e (entget ss1))
         (entmakex (list '(0 . "INSERT")
                         (cons 2 Blkname)
                         (assoc 10 e)
                         '(41 . 1.)
                         '(42 . 1.)
                         '(43 . 1.)
                   )
         )
      )
    )
   -1
   )
   (cond ((or (eq Blkname nil) (eq Blkname ""))
          (princ "\n Cancelled by the user ")
         )
         ((not (tblsearch "BLOCK" Blkname))
          (princ "\n Block name is not found !! ")
         )
         ((not ss) (princ "\n No points selected "))
   )
)
(princ)
)

 
塔瓦特

teknomatika 发表于 2022-7-6 09:15:33

塔尔瓦特，
我测试了你的版本，效果很好。对于初学者来说，这似乎是一个更简洁的代码。我想。

Tharwat 发表于 2022-7-6 09:21:50

 
谢谢你，我希望你能从中吸取教训。
 
塔瓦特

stevesfr 发表于 2022-7-6 09:27:16

 
为什么不使用Lee Mac PtManager？http://www.lee-mac.com/ptmanager.html

teknomatika 发表于 2022-7-6 09:38:41

是的，当然，但要慢慢来。lisp语言并不是最直观的。

VVA 发表于 2022-7-6 09:44:08

http://www.cadtutor.net/forum/showthread.php?50172-用块替换圆&p=340865&viewfull=1#post340865

Lee Mac 发表于 2022-7-6 09:53:34

AUGI处的类似螺纹：
http://forums.augi.com/showthread.php?t=133806

查看完整版本: 阻止所有点