[LISP程序]：选择对象直接生成一个采用EntMake方式生成对象的LISP程序.

YueFeng · 发表于 2004-12-20 22:21:44

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

有时采用采用EntMake生成对象的速度很快的。自写了一个根据选择的对象生成一个采用EntMake方法生成对象的另外一个LISP程序的LISP程序。

[FONT=courier new]
(Defun YFCAD_Remove(LST O / K X RST)
(SetQ K 0)
(ForEach X LST
(If (/= X O)
(SetQ RST (Cons X RST))
(Progn
(If (= K 0)
(SetQ K (1+ K))
(SetQ RST (Cons X RST))
)
)
)
)
(Reverse RST)
)
(Defun C:YF_OutPutLSP(/ Sel L N FLN FLO Data DaNe)
(Prompt "\n请选择要采用LISP程序，ENTMAKE方法建立的对象：")
(SetQ Sel (SsGet)
L (SsLength Sel)
N 0
FLN (GetFileD "输出的LISP文件:" "" "LSP" 1)
FLO (Open FLN "a")
)
(Write-Line "(Defun YF_Write()" FLO)
(Repeat L
(SetQ Data (EntGet (SsName Sel N))
DaNe (YFCAD_Remove Data (Assoc -1 Data))
DaNe (YFCAD_Remove DaNe (Assoc 330 Data))
DaNe (YFCAD_Remove DaNe (Assoc 360 Data))
DaNe (YFCAD_Remove DaNe (Assoc 5 Data))
N (1+ N)
)
(Write-Line (StrCat " (EntMake '" (Vl-Prin1-To-String DaNe) ")") FLO)
;(Write-Line " (EntLast)" FLO)
)
(Write-Line ")" FLO)
(Close FLO)
)
[/FONT]

复制代码

LUCAS · 发表于 2004-12-21 13:23:52

;;ENTMAKE對某些物件(PLINE,INSERT....)不能生成!!
;;程序主要用在那方面?
(defun C:YF_OUTPUTLSP_LAI (/ SEL L N FLN FLO DATA)
(prompt "\n請選擇要採用LISP程序，ENTMAKE方法建立的對象：")
(setq SEL (ssget)
L (sslength SEL)
N 0
FLN (getfiled "輸出的LISP文件:" "" "LSP" 1)
FLO (open FLN "a")
)
(write-line "(Defun YF_Write()" FLO)
(repeat L
(setq DATA (entget (ssname SEL N))
DATA (vl-remove-if
'(lambda (X)
(if (vl-position (car X) '(-1 330 360 5))
X
)
)
DATA
)
N (1+ N)
)
(write-line
(strcat " (EntMake '" (vl-prin1-to-string DATA) ")")
FLO
)
;;(Write-Line " (EntLast)" FLO)
)
(write-line ")" FLO)
(close FLO)
(princ)
)

;;ENTMAKE對某些物件(PLINE,INSERT....)不能生成!! 
;;程序主要用在那方面? 
(defun C:YF_OUTPUTLSP_LAI (/ SEL L N FLN FLO DATA) 
  (prompt "\n請選擇要採用LISP程序，ENTMAKE方法建立的對象：") 
  (setq        SEL (ssget) 
        L   (sslength SEL) 
        N   0 
        FLN (getfiled "輸出的LISP文件:" "" "LSP" 1) 
        FLO (open FLN "a") 
  ) 
  (write-line "(Defun YF_Write()" FLO) 
  (repeat L 
    (setq DATA (entget (ssname SEL N)) 
          DATA (vl-remove-if 
                 '(lambda (X) 
                    (if        (vl-position (car X) '(-1 330 360 5)) 
                      X 
                    ) 
                  ) 
                 DATA 
               ) 
          N    (1+ N) 
    ) 
    (write-line 
      (strcat "   (EntMake '" (vl-prin1-to-string DATA) ")") 
      FLO 
    ) 
    ;;(Write-Line "   (EntLast)" FLO) 
  ) 
  (write-line ")" FLO) 
  (close FLO) 
  (princ) 
)

YueFeng · 发表于 2004-12-22 10:17:52

对旧多段线与图块是不合适的。
如果对TEXT等含有字形定义的话，就要考虑新建文件有没有这个字形了。
程序，原先设计是用在一个程序内部自动生一个图标。
谢谢，楼上的修改!

拉契 · 发表于 2014-4-7 17:47:28

本帖最后由拉契于 2014-4-7 17:59 编辑

会多出
(330 . <图元名: 7ffffb03ec0>)
(340 . <图元名: 7ffffb03e00>)

要手动删除才可以！版主再优化一下呗{:soso_e100:}

/db_自贡黄明儒_ · 发表于 2014-4-19 13:06:11

本帖最后由 /db_自贡黄明儒_ 于 2014-4-19 13:07 编辑

拉契发表于 2014-4-7 17:47
会多出
(330 . )
(340 . )

版主忙，我改写了一下，看看行不行？
;;http://bbs.xdcad.net/thread-316651-1-1.html

(defun C:EntmakeLsp (/ DATA FLN FLO LST N SS Y)
(cond
((and (princ "\n 选择对象，产生ENTMAKE方法：")
(setq ss (ssget))
(setq FLN (getfiled "輸出的LISP文件:" "" "LSP" 1))
(setq FLO (open FLN "w"))
)
(write-line "(Defun ENTMAKE_Write()" FLO)
(setq lst '(-1 330 360 5 410 8 7 340))
(repeat (setq n (sslength ss))
(setq DATA (entget (ssname ss (setq n (1- n)))))
(foreach X lst
(while (setq y (assoc X DATA))
(setq DATA (vl-remove y DATA))
)
)
(write-line (strcat " (EntMake '" (vl-prin1-to-string DATA) ")") FLO)
)
(write-line ")" FLO)
(close FLO)
)
)
(princ)
)

myzwsc · 发表于 2014-9-23 02:56:33

谢谢，学习下

kkt123 · 发表于 2015-2-3 11:18:37

谢谢，学习下;P

Michael527 · 发表于 2017-6-25 08:21:58

三位大师写的程序都可以运行，谢谢了，方便不少

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：选择对象直接生成一个采用EntMake方式生成对象的LISP程序.

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评