明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1952|回复: 4

帮我改下LSP,谢谢!!

[复制链接]
发表于 2012-3-8 14:46:51 | 显示全部楼层 |阅读模式
(defun c:FE (/ cmd ss1 ss2)
  
  ;;  get all objects touching entities in the sscross
  ;;  limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
  (defun gettouching (sscros / ss lst lstb lstc objl)
    (and
      (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
            objl (mapcar 'vlax-ename->vla-object lstb)
      )
      (setq
        ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
                             (cons 410 (getvar "ctab"))))
      )
      (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq lst (mapcar 'vlax-ename->vla-object lst))
      (mapcar
        '(lambda (x)
           (mapcar
             '(lambda (y)
                (if (not
                      (vl-catch-all-error-p
                        (vl-catch-all-apply
                          '(lambda ()
                             (vlax-safearray->list
                               (vlax-variant-value
                                 (vla-intersectwith y x acextendnone)
                               ))))))
                  (setq lstc (cons (vlax-vla-object->ename x) lstc))
                )
              ) objl)
         ) lst)
    )
    lstc
  )

  (command "._undo" "_begin")
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq ss1 (ssadd))
  ;;  get objects to break
  (if (and (not (prompt "\nSelect object(s) to break with & press enter: "))
           (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
           (mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))
      )
    (break_with ss2 ss1 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
  )

  (setvar "CMDECHO" cmd)
  (command "._undo" "_end")
  (princ)
)


===========================
这个程序帮我改下。

使他可以先选择对象,后执行命令

谢谢!!
发表于 2012-3-8 17:30:10 | 显示全部楼层
这个是什么功能?
发表于 2012-3-8 23:11:27 | 显示全部楼层
(defun c:fe (/ cmd ss1 ss)               ;  get all objects touching entities in the sscross
                                       ;  limited obj types to "line,arc,spline,lwpolyline,polyline,circle,ellipse"
  (defun gettouching (sscros / ss lst lstb lstc objl)
    (and
      (setq lstb (vl-remove-if 'listp (mapcar
                                        'cadr
                                        (ssnamex sscros)
                                      )
                 )
            objl (mapcar
                   'vlax-ename->vla-object
                   lstb
                 )
      )
      (setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE") (cons 410 (getvar "ctab")))))
      (setq lst (vl-remove-if 'listp (mapcar
                                       'cadr
                                       (ssnamex ss)
                                     )
                )
      )
      (setq lst (mapcar
                  'vlax-ename->vla-object
                  lst
                )
      )
      (mapcar
        '(lambda (x)
           (mapcar
             '(lambda (y)
                (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
                                                                      (vlax-safearray->list (vlax-variant-value
                                                                                                                (vla-intersectwith y
                                                                                                                                   x acextendnone
                                                                                                                )
                                                                                            )
                                                                      )
                                                                    )
                                               )
                         )
                    )
                  (setq lstc (cons (vlax-vla-object->ename x) lstc))
                )
              )
             objl
           )
         )
        lst
      )
    )
    lstc
  )
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)                       ;  get objects to break
  (setq ss1 (ssadd))
  (prompt "\nselect object(s) to break with & press enter: ")
  (if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
    (progn
      (command "._undo" "_begin")
      (mapcar
        '(lambda (x)
           (ssadd x ss1)
         )
        (gettouching ss)
      )
      (break_with ss ss1 nil)
      (command "._undo" "_end")
    )                                       ; ssbreak ssbreakwith (flag nil = not to break with self)
  )
  (setvar "CMDECHO" cmd)
  (princ)
)
发表于 2012-3-9 14:10:22 | 显示全部楼层
没看懂,正在学习中……谢谢
发表于 2012-3-9 16:02:16 | 显示全部楼层
langjs 发表于 2012-3-8 23:11
(defun c:fe (/ cmd ss1 ss)               ;  get all objects touching entities in the sscross
                                       ;  ...


; 错误: no function definition: BREAK_WITH
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-9-25 02:50 , Processed in 0.316072 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表