lskang001 发表于 2009-7-30 12:41:00

紧急求助：谁能编一个框选水平直线、竖直直线的LISP透明命令

<p>紧急求助：谁能编一个框选水平直线、竖直直线的LISP透明命令</p><p>功能：1、要求为透明命令，以方便在某些CAD命令提示选择对象时可以采用。</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 2、框选范围内判断是水平直线（Y坐标增量为0）还是竖直直线（X坐标增量为0）。</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 3、虽然用CAD里的快速选择命令可以实现该功能，但是我想要一个LISP的透明命令，因为我想在在其他的LISP程序中调用它，而快速选择中的选择方法我没法调用（就算调用也还需要手动选择几个选项，没法自动化）。</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 请高手帮忙，虽然大致知道怎么判断（比如用程序判断X或Y坐标增量是否为0，或判断该条直线的角度是否为0度或90度），小弟LISP不怎么行，写了好久也没反映。</p><p>谢谢。</p>

lskang001 发表于 2009-7-30 13:09:00

<p>顶起来</p><p></p>

淮上 发表于 2009-7-30 13:34:00

透明命令可以定义，但和当前命令交换数据似乎有点麻烦

lskang001 发表于 2009-7-30 16:04:00

<p>如果实在做不成透明的指令，那么不透明的也可以啊，知识透明的会更方便的使用</p>

lskang001 发表于 2009-7-30 19:44:00

<p>哎，没人帮忙编，只好自己来乱凑了，凑了好久，凑出了几句语句，可不知道为什么，提示语法错误，请帮忙看下哪里有问题：</p><p>(defun c:ttt(/ ss n i ent1 ang1)<br/>&nbsp;&nbsp; (setq ss (ssget '((0 . "line"))))&nbsp; <br/>&nbsp;&nbsp; (if ss&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq n (sslength ss))<br/>&nbsp;&nbsp; )&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp; (setq i 0)<br/>&nbsp;&nbsp; (while (&lt; i n)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq ent1 (ssname ss i))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq p1 (entget ent1))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq ang1 (angle (dxf 10 p1)(dxf 11 p1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (if ang1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (ssdel ent1 ss) <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq i (- i 1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq n (- n 1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq i (1+ i))<br/>&nbsp;&nbsp; )<br/>&nbsp; (command "erase" ss "")<br/>&nbsp; (princ)<br/>)</p><p>(defun dxf (code elist) (cdr (assoc code elist)))</p><p>命令: ; 错误: 语法错误<br/>命令: ; 错误: 语法错误</p><p><br/></p>

z394326635 发表于 2009-7-30 20:56:00

lskang001 发表于 2009-7-31 00:53:00

<p>试了大半夜</p><p>初步调整成这样</p><p>大家看看对不对</p><p>水平线的：</p><p>(defun c:ttt(/ ss n i ent1 ang1)<br/>&nbsp;&nbsp; (setq ss (ssget '((0 . "line"))))<br/>&nbsp;&nbsp; (if ss&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq n (sslength ss))<br/>&nbsp;&nbsp; )&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp; (setq i 0)<br/>&nbsp;&nbsp; (while (&lt; i n)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq ent1 (ssname ss i))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq p1 (entget ent1))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq ang1 (angle (dxf 10 p1)(dxf 11 p1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (if (not(or(= ang1 0)(= ang1 pi)(= dang (- 0 pi)))) (ssdel ent1 ss))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (if (not(or(= ang1 0)(= ang1 pi)(= dang (- 0 pi)))) (setq i (- i 1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (if (not(or(= ang1 0)(= ang1 pi)(= dang (- 0 pi)))) (setq n (- n 1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq i (1+ i))<br/>&nbsp;&nbsp; )<br/>&nbsp; (command "erase" ss "")<br/>&nbsp; (princ)<br/>)；其中最后的SS为处理过的选择集，就是我们要的水平线</p><p>(defun dxf (code elist) (cdr (assoc code elist)))</p><p>垂直线的：</p><p>(defun c:czz(/ ss n i ent1 ang1)<br/>&nbsp;&nbsp; (setq ss (ssget '((0 . "line"))))<br/>&nbsp;&nbsp; (if ss&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq n (sslength ss))<br/>&nbsp;&nbsp; )&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp; (setq i 0)<br/>&nbsp;&nbsp; (while (&lt; i n)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq ent1 (ssname ss i))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq p1 (entget ent1))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq ang1 (angle (dxf 10 p1)(dxf 11 p1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (if (not(or(= ang1 (/ pi 2))(= ang1 (- 0 (/ pi 2)))(= ang1 (+ pi (/ pi 2)))(= ang1 (- 0 (+ pi (/ pi 2)))))) (ssdel ent1 ss))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (if (not(or(= ang1 (/ pi 2))(= ang1 (- 0 (/ pi 2)))(= ang1 (+ pi (/ pi 2)))(= ang1 (- 0 (+ pi (/ pi 2)))))) (setq i (- i 1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (if (not(or(= ang1 (/ pi 2))(= ang1 (- 0 (/ pi 2)))(= ang1 (+ pi (/ pi 2)))(= ang1 (- 0 (+ pi (/ pi 2)))))) (setq n (- n 1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq i (1+ i))<br/>&nbsp;&nbsp; )<br/>&nbsp; (command "erase" ss "")<br/>&nbsp; (princ)<br/>))；其中最后的SS为处理过的选择集，就是我们要的垂直线</p><p>(defun dxf (code elist) (cdr (assoc code elist)))<br/></p>

Andyhon 发表于 2009-7-31 09:53:00


(vl-load-com)
;; acet-* required
(Defun HVLineSS (2Test)
   (setq nn (sslength 2Test))
   (while (setq ee (ssname 2Test (setq nn (1- nn))))
   (mapcar 'set '(pa pb) (acet-ent-geomextents ee))
   (if
       (or
         (equal (car pa) (car pb) 1e-13)
         (equal (cadr pa) (cadr pb) 1e-13)
       )
       nil                  ; (entdel ee)
       (ssdel ee 2Test)
    )
)
2Test
)
(Defun HV ()
   (Cond
    ((null (setq ss (ssget '((0 . "LINE"))))) nil)
    (T (setq rtn (HVLineSS ss)))
   )
   (vla-SendCommand
   (vla-get-ActiveDocument (vlax-get-acad-object))
   "!rtn "
   )
)
(vlax-remove-cmd "hv")
(vlax-add-cmd "hv" 'hv "hv" ACRX_CMD_TRANSPARENT)
=====================================================
Command: copy
Select objects: 'hv                   ; TRANSPARENT
>>Select objects: All 8 found
>>Select objects:
Resuming COPY command.
Select objects: !rtn <Selection set: 28>
6 found
Select objects:
.....

淮上 发表于 2009-7-31 10:15:00

<font color="#ff00ff">变量&nbsp;rtn 如何清除呢？</font>

lskang001 发表于 2009-7-31 14:01:00

<p>; 错误: no function definition: ACET-ENT-GEOMEXTENTS<br/>正在恢复执行 COPY 命令。</p><p>我运行起来，说是ACET-ENT-GEOMEXTENTS函数没定义，查了好象是EXPRESSTOOL中的公共函數，但是我用的是CAD2009，没法装这个EXPRESSTOOL，请问怎么办？</p>
页: [1] 2
查看完整版本: 紧急求助：谁能编一个框选水平直线、竖直直线的LISP透明命令