注册 登录
明经CAD社区 返回首页

wowan1314的个人空间 http://www.mjtd.com/?282351 [收藏] [复制] [分享] [RSS]

日志

随手收集的技巧，资料。

热度 12已有 3140 次阅读2013-4-15 11:00 |系统分类:应用| 时间, 时间, 时间, 时间, 时间, 时间, 时间, 时间, 时间, 时间, 时间

可以生成编组，但操作编组不靠谱：
1、不能在文档间复制，会丢失编组
2、添加新实体到已有编组，不靠谱，有时会出错。
3、分解有实体的编组不靠谱。尤其是一个实体的编组。生成nil的编组。复制后会还原。删除编组后马上重启CAD才可以。
把编组当做是扩展数据的补充数据仅此而已。以上测试在CAD2010与CAD2012上测得。
;求组名其它方法－－－－ from AutoCAD讨论组. snsj 修改 ok!
;返回: ("X2" "X1")
(defun objid (vla) (vla-get-objectid vla))
(defun c:test (/ doc theobj grp obj kj ip)
  (setq doc (vla-get-Activedocument (vlax-get-acad-object)))
  (vla-getentity
    (vla-get-utility doc)
    'theobj
    'ip
    "\nSelect Object: "
  )
  (vlax-for grp (vla-get-groups doc)
    (vlax-for obj grp
      (if (equal (objid obj) (objid theobj))
(setq kj (cons (vla-get-name grp) kj))
      )
    )
  )kj
)

一、小技巧
快速新建默认样板(getenv "qnewtemplate")
 规范代码写法：
                1. 全局自定义函数有固定前缀如：LM:TRANSANG 其中LM:为全局自定义函数的前缀，后面是功能描述简写。
                2.局部自定义函数有前缀但不固定如：主程序快捷键ML 那么函数前缀就用ML:TRANSANG。
                3.函数内部变量命名 变量的取名要有意义 不是全局变量就不用加前缀 。
                4.全局变量尽量保存到图纸词典中，不然，全局变量可加前后缀区别*ML#VIEW*。
                5.快捷键名称有固定前缀如：LM-TZML，注意分隔符的不同。实际操作快捷键通过pgp指定.

           这样可以方便直观的看到代码中
                   1、带LM-为快捷键,
                   2、LM:为自定义函数。
                   3、ML:为局部函数且为ML程序的局部函数。
                   4、*ML#VIEW*为ML程序的全局变量。
                   5、PT  STR NUM TXT LST LENG HIGH等为的局部变量。。

VL-SORT函数对于整数型元素会消重。一般实际不会有此情况。 安心期间可使用vl-sort-i函数代替。
或者对整数float 排序完后再fix。 还是用前者好些.

提高代码效率小技巧   BY  --ZZXXQQ

1、能用整数不用浮点；
2、变量名字母长度不要超过6个；
3、用cons代替append；
4、采用好的算法；
5、如可能少用command函数；
6、用乘法代替除法(/ pi 2)-->(* pi 0.5)，用加法代替乘法(* pi 2)--> (+ pi pi)；
7、用空间换时间，设中间变量保存中间计算数值，不重复计算；
8、使用1+函数代替(+ n 1)，1-函数代替(- n 1)；


NIL也是表。（if nil  nil (princ "123")）
在用AND语句时,有些函数返回始终NIL那么可以这样改造下：（PROGN (PRINC "123") T）这样就可以返回T了。
SETENV及GETENV配合来设置或得到系统环境变量。

二、资料
  • ;;假设 (setq l1  '((1 3 2) (2 3 4) (3 4 5)))
  • ;;     (setq l2 '(( 3 4 2) (3 5 1) (4 6 7)))
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list l1 l2))
/=mapcar min l1 及 mapcar max l2 而是等价于(list (apply 'mapcar (cons 'min l1)) (apply 'mapcar (cons 'max l2)))

而(mapcar '1+ '(1 2 3))=((1+ 1) (1+ 2) (1+ 3))  
我把复杂的问题想简单化了！ 导致错误。
（mapcar 'max l2）与(apply 'mapcar (cons 'max l2)))是不同的！！！！
(setq l2 '(( 3 4 2) (3 5 1) (4 6 7)))
(MAPCAR 'MAX '( 3 4 2) '(3 5 1) '(4 6 7))= (apply 'mapcar (cons 'max l2))

  1. ;;假设 (setq l1  '((1 3 2) (2 3 4) (3 4 5)))
  2. ;;     (setq l2 '(( 3 4 2) (3 5 1) (4 6 7)))
  3. (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
  4.         '(min max)
  5.         (list l1 l2)
  6.         )
  7. 结果：'((1 3 2) (4 6 7))
  8. 上式等价与==> 
  9. (list
  10.   ((lambda (a b) (apply 'mapcar (cons a b)))
  11.     'min l1)
  12.   ((lambda (a b) (apply 'mapcar (cons a b)))
  13.     'max l2)
  14.   )
  15. 上式等价与==> 
  16. (list
  17.   (apply 'mapcar (cons 'min l1))
  18.   (apply 'mapcar (cons 'max l2))
  19.   )
  20. 上式等价与==> 
  21. (list
  22.   (apply 'mapcar (list 'min '(1 3 2) '(2 3 4) '(3 4 5)))
  23.   (apply 'mapcar (list 'max '( 3 4 2) '(3 5 1) '(4 6 7)))
  24.   )
  25. 上式等价与==> 
  26. (list
  27.   (list
  28.   (min 1 2 3)
  29.   (min 3 3 4)
  30.   (min 2 4 5)
  31.   )
  32.   (list
  33.     (max 3 3 4)
  34.     (max 4 5 6)
  35.     (max 2 1 7)
  36.     )
  37.   )

变量里最好不要含L，以免小写情况下与1分不清楚。不便检查。
如何去掉表的闭括号"()" _$ (setq lst '(1 2 3 4 5))
(1 2 3 4 5)
_$ (vl-string-trim "()" (vl-princ-to-string lst))
"1 2 3 4 5"
_$

  (command "insert" "*sb.dwg" pause 1 1 0)前面加*就可吧块砸开
  (command "_.explode" "L");注意这个L的运用
  (command "_.chprop" "P" "" "LA" (getvar "CLAYER") "");注意这个P的运用
；；(command "_.QLEADER" p1 p2 ^C "_.TEXT" "M" (polar p2 (angle p1 p2) 10) 20 0 "0.0") ^C这都行？！！


例如：
_$ (mixstring->list "中文使用-.123abc-0.45fff")
输出：
("中文使用" "-.123" "abc" "-0.45" "fff")--------------BY --QLIN
  1. (defun mixstring->list (str_in / lst_out n len1 lst_n
  2.                       chr_c chr_n chr_p
  3.                       str_c str_id 
  4.                       num_add str_add)
  5.   (defun num_add ()
  6.     (if str_id
  7.       (progn
  8.         (if (/= str_c "")(setq lst_out (cons str_c lst_out)))
  9.         (setq  str_c chr_c
  10.               str_id nil
  11.         );setq
  12.       )
  13.       (setq str_c (strcat str_c chr_c))
  14.     );if
  15.   )

  17.   (defun str_add ()
  18.     (if str_id
  19.       (setq str_c (strcat str_c chr_c))
  20.       (progn
  21.         (if (/= str_c "")(setq lst_out (cons str_c lst_out)))
  22.         (setq  str_c chr_c
  23.               str_id T
  24.         );setq
  25.       )
  26.     );if
  27.   )
  28.   
  29.   ;C-1: 加入对输入值的判断
  30.   (if (and str_in (/= str_in ""))
  31.     (setq len1 (strlen str_in))
  32.     (setq len1 0)
  33.   )
  34.   
  35.   (setq n 1
  36.         lst_n (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
  37.         str_c "")

  39.   (repeat len1
  40.     (setq chr_c (substr str_in n 1))
  41.     (cond
  42.       ((member chr_c lst_n)
  43.        (num_add)
  44.       )
  45.       ((= chr_c ".")
  46.        (if (< n len1)
  47.           (setq chr_n (substr str_in (1+ n) 1))
  48.          (setq chr_n "")
  49.        );if
  50.        (if (member chr_n lst_n)
  51.          (num_add)
  52.          (str_add)
  53.         )      
  54.       )
  55.       ((= chr_c "-")
  56.        (if (< n len1)
  57.           (setq chr_n (substr str_in (1+ n) 1))
  58.          (setq chr_n "")
  59.        );if
  60.        (if (or (member chr_n lst_n)(= chr_n "."))
  61.          (num_add)
  62.          (str_add)
  63.         )
  64.       )
  65.       ((= chr_c "+")
  66.        (if (< n len1)
  67.           (setq chr_n (substr str_in (1+ n) 1))
  68.          (setq chr_n "")
  69.        );if
  70.        (if (or (member chr_n lst_n)(= chr_n "."))
  71.          (num_add)
  72.          (str_add)
  73.         )
  74.       )
  75.       ((or (= chr_c "E")(= chr_c "e"))
  76.        (if (< n len1)
  77.           (setq chr_n (substr str_in (1+ n) 1))
  78.          (setq chr_n "")
  79.        );if
  80.        ;C-2: 修改判断条件使之支持‘2e-3’类型的数据
  81.        (if (or
  82.              (and (member chr_n lst_n)(member chr_p lst_n))
  83.              (and (= chr_n "+")(member chr_p lst_n))
  84.              (and (= chr_n "-")(member chr_p lst_n))
  85.            );or
  86.          (num_add)
  87.          (str_add)
  88.         )
  89.       )
  90.       (T(str_add))
  91.     );cond
  92.     
  93.     (setq n (1+ n)
  94.           chr_p chr_c
  95.     )
  96.   );repeat

  98.   (if (> len1 0)
  99.     (progn
  100.       (if (/= str_c "")(setq lst_out (cons str_c lst_out)))
  101.       (setq lst_out (reverse lst_out))
  102.     );progn
  103.   );if
  104.   lst_out
  105. )


;;;BY ---- LL-J
  1. 3.initget函数中关键字“ ”（空格）的使用
  2.     空格可以被用作关键字，一般多用来定义鼠标右键退出。
  3.     ⑴当用户输入函数不支持控制位（如entsel、nentsel、nentselp）时，可直接使用
  4. “(initget " ")”。
  5.     ⑵当用户输入函数支持控制位（如getpoint等）时，可使用“(initget 1 " ")”禁止空输
  6. 入，而将回车等空输入作为关键字使用。
  7.     ⑶当同时使用其它关键字时，应该将空格作为一系列关键字的最后一个，用
  8. “(initget "C  ")”（两个空格）调用，否则无效。
  9.     有时需要进行复杂的判断，使用如“(= s0 "")”语句可能不能准确判别输入的空格关键字
  10. 与空选择，可以使用“(= (type s0) 'STR)”语句。
  11.  

  • 6.数学运算函数的数量界限
  •     在Lisp中对表中数据进行求和、求最大值等数学运算时，往往直观的对表直接赋予运算函数，
  • 使用语句如“(eval (cons 'MAX numlist))”，一般都可以进行计算，但当表中数据数量大于
  • 255时，将会出现错误“bad argument value: does not fit in byte: 256”。
  •     对于这种情况，我们不必对数据表进行分段，可以直接使用函数apply，语法更简单：(apply 
  • 'MAX numlist)。apply可将数据表传送给指定的函数进行求值而不受数据数量的影响。
  •     受表中数据数量影响的数学运算函数有：+、-、*、/、max、min、logand及logior。

  • 7.选择集与表
  •     选择集是一种特殊结构的表，只能通过特定的函数进行操作，但这些函数对大量重复的操作
  • 只能通过循环实现，显得力不从心，不能体现Lisp语言表结构的优越性。
  •     其实我们只要通过存取实体名或实体句柄，将它们存为一个普通结构的表，完全可以通过常
  • 规表操作函数实现对实体的操作。
  •     例四是一段使用apply、mapcar函数联合求文本选择集中文本基点最大y值得代码，只是一个
  • 示例，如果结合VL-sort函数，可轻松实现对文本的排序。   

    1. 9.Undo处理
    2.     一个完善的程序应该有较好的出错处理，这是在所有Lisp教材上都提及的，但程序的Undo处
    3. 理就说得很少或没有提及。
    4.     其实Undo处理对程序来说也是非常重要的，尤其对有较多输出的复杂程序而言，不能解决
    5. Undo问题，使用起来会极不方便。
    6.     对于Undo问题的解决，一种方法是尽量少用或不用command函数，即不调用原始命令，这是一
    7. 种较好的方法，但必须注意的是，一段程序必须至少有一次调用command函数，否则Undo命令将取
    8. 消程序运行前的前一次命令，解决的方法是在程序运行的起始位置加一个无谓的command，如
    9. “(command "color" "")”。
    10.     有时不使用command函数不能达到我们要求的一些功能，或使得程序过于复杂，我们可能需要
    11. 使用一些command函数（原始命令），这是就应该在程序中进行Undo处理，即使用Undo命令的编组
    12. 功能。


    ;;;-----------------------------------------------------------;;
;;;Highflybird  2008.03.22 海南    2013.04.28 修订于深圳      ;;
;;;-----------------------------------------------------------;;
;;;程序功能：画出选择集的包围盒，可适用于UCS下                ;;
;;;免责申明：本着开源的精神，此代码可以免费拷贝复制，但使用此 ;;
;;;          程序带来的一切责任由使用者这承担。               ;;
;;;程序用法：命令为Test,选择一个或多个，自动创建物体包围盒    ;;
;;;-----------------------------------------------------------;;
(defun C:Test (/ B DOC ENT I ISUCS LL LR UL UR MATRIX REVMAT OBJ  SEL pl)
  ;;先判断UCS是否与WCS相同。 
  ;;如是UCS，得到UCS变换矩阵和到WCS的逆变换矩阵
  (if (zerop (getvar "WORLDUCS"))                            	;UCS是否与WCS相同
    (setq IsUCS T                                             	;设置标志位为true
	  matrix (vlax-tmatrix (MAT:Trans 1 0))                 ;UCS的变换矩阵 
	  revMat (vlax-tmatrix (MAT:Trans 0 1))                 ;UCS的逆变换矩阵
    )
    (setq IsUCS nil)                                          	;否则不予变换
  )
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  ;;在UCS下先变换物体到WCS下，取得每个物体的包围框，
  ;;求出包围框集合的最小XY，最大XY，并用矩形框画出来
  ;;然后把物体变换回到UCS，并把矩形也变换回去
  (if (setq sel (ssget))                        		;选择物体
    (progn
      (setq i 0)
      (vla-StartUndoMark doc)
      (repeat (sslength sel)
	(setq ent (ssname sel i))                               ;图元
	(setq obj (vlax-ename->vla-object ent))                 ;obj对象
	(and IsUCS (vla-TransformBy obj revMat))              	;反变换到WCS
	(vla-GetBoundingBox obj 'll 'ur)                  	;得到包围框
	(setq ll (vlax-safearray->list ll))
	(setq ur (vlax-safearray->list ur))
	(setq pl (cons ll pl))                       		;得到左下角点表
	(setq pl (cons ur pl))                       		;得到右上角点表
	(and IsUCS (vla-TransformBy obj matrix))              	;变换回到UCS
	(setq i (1+ i))                                         
      )
      (setq ll (apply 'mapcar (cons 'min pl)))			;左下角
      (setq ur (apply 'mapcar (cons 'max pl)))                  ;右上角
      (setq lr (list (car ll) (cadr ur) (caddr ll)))            ;右下角
      (setq ul (list (car ur) (cadr ll) (caddr ur)))            ;左上角
      (setq b (Make3dPoly (list ll lr ur ul)))			;构造边框
      (if IsUCS							;如果UCS
	(vla-TransformBy (vlax-ename->vla-object b) matrix)     ;变换边框到UCS
      )
      (vla-EndUndoMark doc)
    )
  )
  (princ)
)

;;;-----------------------------------------------------------;;
;;; 从一个坐标系统到另一个坐标系统的变换矩阵                  ;;
;;; 输入：from - 源坐标系；to - 目的坐标系                    ;;
;;; 输出：一个4X4的变换CAD的标准变换矩阵                      ;;
;;;-----------------------------------------------------------;;
(defun MAT:Trans (from to)
  (append
    (MAT:trp
      (mapcar
	(function (lambda (v d) (trans v from to d)))
	'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.) (0. 0. 0.))
	(list t t t nil)
      )
    )
    '((0. 0. 0. 1.))
  )
)

;;;-----------------------------------------------------------;;
;;; 矩阵转置   MAT:trp Transpose a matrix -Doug Wilson-       ;;
;;; 输入：矩阵                                                ;;
;;; 输出：转置后的矩阵                                        ;;
;;;-----------------------------------------------------------;;
(defun MAT:trp (m)
  (apply 'mapcar (cons 'list m))
)

;;;-----------------------------------------------------------;;
;;; 画3d多段线                                                ;;
;;; draw a closed 3d Polyline                                 ;;
;;;-----------------------------------------------------------;;
(defun Make3dPoly (pts / e)
  (setq e (Entmake (list '(0 . "POLYLINE")'(70 . 9))))
  (foreach p Pts
    (entmake (list '(0 . "VERTEX") '(70 . 32) (cons 10 p)))
  )
  (entmake '((0 . "SEQEND")))
  (entlast)
)

(vl-load-com)
(prompt "\n请输入命令test")
(princ)


    ;有些字型写的字textbox 的第一个值不一定是原点，所以求包围盒和求距离都要相应的减一下. 
;;参数 str -- 字串 h --- 字高 wid --- 宽度因子 by eachy 
(defun xd-text_length (str h wid / bx) 
    (setq bx (textbox
            (list (cons 40 h)
                (cons 1 str)
                (cons 41 wid)
                (cons 7 (getvar "textstyle"))
            )
        )
    )
    (- (caadr bx)(caar bx))
)
    下面摘自 G版
    经验不都是对的！不要误导人！参数个数的限制是针对eval函数的，而非max函数！max函数参数个数没有限制！
    试试
    (apply 'max a)




    路过
    雷人
    9

    握手
    3

    鲜花
    鸡蛋

    刚表态过的朋友 (12 人)

    收藏 分享邀请 举报

    全部作者的其他最新日志

    发表评论 评论 (1 个评论)

    回复 jxjaxa 2013-4-24 20:28
    太好了大黄瓜

    facelist doodle 涂鸦板

    您需要登录后才可以评论 登录 | 注册

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

    GMT+8, 2024-4-19 19:11 , Processed in 0.437355 second(s), 16 queries , Gzip On.

    Powered by Discuz! X3.4

    Copyright © 2001-2021, Tencent Cloud.

    返回顶部