设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 5137|回复: 16

[源码] 通用收集

[复制链接]

已领礼包: 48个

财富等级: 招财进宝

发表于 2013-8-4 23:55:17 | 显示全部楼层 |阅读模式

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

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
  1. (defun c:dxx (/ a mumer tysm tysm tyl sjl tcl zqm chklay)
  2. ;;;梦扬软件独立注册模块改进优化版
  3. ;;;Copyrignt chengqiang Lin 2012 for mengyang(作者:林承强)
  4. (defun CODE_Str ()
  5. (defun mc_PopupBox (strText intWaitTime strTitle intDispType)
  6. (vlax-invoke-method
  7.     (vlax-create-object "wscript.shell")
  8.     'Popup
  9.     strText
  10.     intWaitTime
  11.     strTitle
  12.     intDispType
  13. )
  14. )
  15. (defun End_Off_Ri ()
  16.     (vl-load-com)
  17.     (mc_PopupBox
  18.       "梦扬软件CAD工具集需获得授权方可正常使用,点击确定输入授权码!"
  19.       0.5
  20.       "提示:"
  21.       48
  22.     )
  23.     (setq cv (load_dialog "cv.dcl"))
  24.     (setq what_next 2)
  25.     (while (>= what_next 2)
  26.       (if (null (new_dialog "my" cv))
  27. (exit)
  28.       )
  29.       (action_tile "code_cv" "(setq code_cv $value)")
  30.       (action_tile
  31. "code_cv_ps"
  32. "(setq Snt $value)"
  33.       )
  34.       (action_tile "ok" "(done_dialog 1)")
  35.       (action_tile "cancel" "(done_dialog 0)")
  36.       (set_tile "code_cv" code_suiji)
  37.       (mode_tile "code_cv_ps" 2)
  38.       (mode_tile "code_cv_ps" 3)
  39.       (mode_tile "code_cv" 1)
  40.       (setq what_next (start_dialog))
  41.       (cond
  42. ((= what_next 1)
  43. (prompt "\n用户取消了操作!\n用户取消了操作!")
  44. )
  45. ((= what_next 0)
  46. (prompt "\n用户取消了操作!\n用户取消了操作!")
  47. )
  48.       )
  49.       (unload_dialog cv)
  50.     )
  51. )
  52. (setvar "cmdecho" 0)
  53. (setq CODE_Str_path_file (strcat "c:\\windows\\system32\\" "MYS.dll"))
  54. (setq code_suiji_1 (open CODE_Str_path_file "r"))
  55. (if (/= code_suiji_1 nil)
  56.     (progn
  57.       (setq CODE_read (read-line code_suiji_1))
  58.       (close code_suiji_1)
  59.     )
  60.     (princ)
  61. )
  62. (if (or (= code_suiji_1 nil) (= CODE_read nil) (= CODE_read ""))
  63.     (progn
  64.       (setq CODE_Cputicks_1 (substr (rtos (getvar "cputicks")) 4 8))
  65.       (setq TT_path_file (strcat "c:\\windows\\system32\\" "MYS.dll"))
  66.       (setq code_suiji_1 (open TT_path_file "w"))
  67.       (setq code_suiji (write-line CODE_Cputicks_1 code_suiji_1))
  68.       (setq snt (write-line "0" code_suiji_1))
  69.       (close code_suiji_1)
  70.       (setq Date (getvar "cdate"))
  71.       (setq Nian       (substr (rtos Date 2 20) 1 4)
  72.      Yue        (substr (rtos Date 2 20) 5 2)
  73.      Ri        (substr (rtos Date 2 20) 7 2)
  74.      Time_Start (strcat nian yue ri)
  75.       )
  76.       (setq CODE_Str_path_file
  77.       (strcat "c:\\windows\\system32\\"
  78.        "MYS.dll"
  79.       )
  80.       )
  81.       (setq code_suiji_x (open CODE_Str_path_file "a"))
  82.       (setq Time_Start_reg (write-line
  83. Time_Start code_suiji_x))
  84.       (setq time_end_ri (rtos (- (+ (atof ri) 180) 30)))
  85.       (setq time_end_yue Yue)
  86.       (if (> (+ (atof ri) 30) 30)
  87. (setq time_end_yue (rtos (+ (atof Yue) 1)))
  88. (princ)
  89.       )
  90.       (if (< (atof time_end_ri) 10)
  91. (setq time_end_ri (strcat "0" time_end_ri))
  92. (princ)
  93.       )
  94.       (if (>= (atof time_end_yue) 13)
  95. (progn (setq time_end_yue "1")
  96.         (setq Nian (rtos (+ (atof Nian) 1)))
  97. )
  98. (princ)
  99.       )
  100.       (if (< (atof time_end_yue) 10)
  101. (setq time_end_yue (strcat "0" time_end_yue))
  102. (princ)
  103.       )
  104.       (setq Time_end (strcat nian time_end_yue time_end_ri))
  105.       (setq Time_end_reg (write-line Time_end code_suiji_x))
  106.       (close code_suiji_x)
  107.     )
  108.     (progn
  109.       (setq CODE_Str_path_file
  110.       (strcat "c:\\windows\\system32\\" "MYS.dll")
  111.       )
  112.       (setq code_suiji_1 (open CODE_Str_path_file "r"))
  113.       (setq code_suiji (read-line code_suiji_1))
  114.       (close code_suiji_1)
  115.       (setq code_suiji_x (open CODE_Str_path_file "r"))
  116.       (repeat 2
  117. (setq snt (read-line code_suiji_x))
  118.       )
  119.       (close code_suiji_x)
  120.       (setq code_suiji_y (open CODE_Str_path_file "r"))
  121.       (repeat 3
  122. (setq Time_Start (read-line code_suiji_y))
  123.       )
  124.       (close code_suiji_y)
  125.       (setq code_suiji_z (open CODE_Str_path_file "r"))
  126.       (repeat 4
  127. (setq Time_end (read-line code_suiji_z))
  128.       )
  129.       (close code_suiji_z)
  130.     )
  131. )
  132. (setq CODE_Right (* (/ (/ (atoi code_suiji) 5) 5) 5))
  133. (if (/= (atof Snt) CODE_Right)
  134.     (progn
  135.       (End_Off_Ri)
  136.       (setq END_Msg_suiji (strcat "\n请记住你的随机数是:" code_suiji))
  137.       (princ END_Msg_suiji)
  138.       (if (/= (atof Snt) CODE_Right)
  139. (progn
  140.    (alert
  141.      "\n你输入的授权码不正确,但你可继续使用梦扬软件的功能,点击确定继续!"
  142.    )
  143. )
  144. (progn
  145.    (alert "\n授权码正确!请继续工作.......!")
  146.    (setq TT_path_file
  147.    (strcat "c:\\windows\\system32\\" "MYS.dll")
  148.    )
  149.    (setq code_suiji_2 (open TT_path_file "w"))
  150.    (setq code_suiji (write-line code_suiji code_suiji_2))
  151.    (setq snt (write-line snt code_suiji_2))
  152.    (setq Time_Start_reg (write-line Time_Start code_suiji_2))
  153.    (setq Time_end_reg (write-line Time_end code_suiji_2))
  154.    (close code_suiji_2)
  155. )
  156.       )
  157.     )
  158.     (princ)
  159. )
  160. (setq CODE_Str_path_file (strcat "c:\\windows\\system32\\" "MYS.dll"))
  161. (setq code_suiji_x (open CODE_Str_path_file "r"))
  162. (repeat 3
  163.     (setq Time_Start_reg (read-line code_suiji_x))
  164. )
  165. (close code_suiji_x)
  166. (setq CODE_Str_path_file (strcat "c:\\windows\\system32\\" "MYS.dll"))
  167. (setq code_suiji_x (open CODE_Str_path_file "r"))
  168. (repeat 4
  169.     (setq Time_end_reg (read-line code_suiji_x))
  170. )
  171. (close code_suiji_x)
  172. (setq Date_now (getvar "cdate"))
  173. (setq Nian_now       (substr (rtos Date_now 2 20) 1 4)
  174. Yue_now        (substr (rtos Date_now 2 20) 5 2)
  175. Ri_now        (substr (rtos Date_now 2 20) 7 2)
  176. Time_Start_now (atof (strcat nian_now yue_now ri_now))
  177. )
  178. (if (or (> Time_Start_now (atof Time_end_reg))
  179.    (< Time_Start_now (atof Time_Start_reg))
  180.       )
  181.     (progn
  182.       (vl-file-delete "c:/windows/system32/MYS.dll")
  183.     )
  184.     (princ)
  185. )
  186. )
  187. (CODE_Str)
  188.   (command "layer" "on" "*" "")
  189.   (prompt "\n单显图层程序:")
  190.   (setq a (ssget))
  191.   (if (not a)
  192.     (command "layer" "on" "*" "" "")
  193.     (progn
  194.       (command "layer" "off" "*" "y" "")
  195.       (setq mumer 0)
  196.       (setq tysm (sslength a))
  197.       (repeat tysm
  198. (setq ty1 (ssname a mumer))
  199. (setq sj1 (entget ty1))
  200. (setq tc1 (cdr (assoc 8 sj1)))
  201. (command "layer" "on" tc1 "")
  202. (command "layer" "on" (strcat (cdr (assoc 8 sj1)) "*") "")
  203. (setq mumer (1+ mumer))
  204.       )
  205.     )
  206.   )
  207.   (princ)
  208. )
  209. ;;;end






  210. ;;;pn3.lsp
  211. ;;;给选择的对象添加文字标注
  212. ;;;输入:选择对象和标注的点位,输入标注文字
  213. ;;;输出:生成引线及标注文字。
  214. ;;;最后修改时间:2012.4.8
  215. ;(defun *error* (msg)  exit)
  216. (defun C:pn3()
  217.   
  218. (setq r 50)
  219. (setq lg_layer "W_DIM");设置标注图层
  220.    (setq txt_style "hztxt");立管标注样式
  221.    (setq g_yesorno 1);设置是否编组,0-不编组,1-编组
  222. (setq txt_size (* r 6)) ;设置标注文字高度
  223. (setq txt_off1 (* r 1)) ;设置标注文字上移尺寸
  224.    (setq txt_off2 (* r 2)) ;设置标注文字左右移尺寸
  225.   
  226. (setvar"cmdecho"0)
  227. (setq var_os (getvar "osmode"));记录捕捉
  228. (setq var_old_layer (getvar "clayer"));记录当前图层
  229. ;判断图层是否存在
  230. (if (= nil (tblsearch "layer" lg_layer)) (command "layer" "m" lg_layer ""))
  231.    ;提示选择对象,获得选择点
  232. (setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))
  233. (while inspt
  234.     (progn
  235.      (setvar "clayer" lg_layer);设置当前图层
  236.      (setvar "osmode" 0);取消捕捉
  237.    
  238.      (setq inspt1 (getpoint inspt "\n点取标注位置"))
  239.    ;绘制连接线
  240.    (command "line" inspt inspt1 "")
  241.    (setq obj_line (entlast))
  242.      (setq txt (getstring "\n标注内容: "))
  243.    
  244.       
  245.    (setq ang (*  (/ (angle inspt inspt1) pi) 180))
  246.      (if (or (<= ang 90) (>= ang 270))
  247.      (progn
  248.       
  249.      ;输入名称和编号
  250.     (command "text" "J" "bl" inspt1 txt_size "0" txt)
  251.     ;选择最后一个图元名
  252.     (setq obj_txt (entlast))
  253.     (command "move" obj_txt "" inspt1 (strcat "@" (rtos txt_off2) "," (rtos txt_off1)))
  254.       
  255.     ;绘制标注底线
  256.         (setq txtb (textbox (entget obj_txt)))
  257.     ;得到文字长度
  258.     (setq txt_l (- (caadr txtb) (caar txtb)))
  259.     (command "line" inspt1 (strcat "@" (rtos (+ txt_l (* txt_off2 2))) ",0") "")
  260.     (setq obj_line2 (entlast))
  261.        )   
  262.      
  263.      (progn
  264.       
  265.      ;输入名称和编号
  266.     (command "text" "J" "br" inspt1 txt_size "0" txt)
  267.     ;选择最后一个图元名
  268.     (setq obj_txt (entlast))
  269.     (command "move" obj_txt "" inspt1 (strcat "@-" (rtos txt_off2) "," (rtos txt_off1)))
  270.       
  271.         ;绘制标注底线
  272.         (setq txtb (textbox (entget obj_txt)))
  273.     ;得到文字长度
  274.     (setq txt_l (- (caadr txtb) (caar txtb)))
  275.         
  276.     (command "line" inspt1 (strcat "@-" (rtos (+ txt_l (* txt_off2 2))) ",0") "")
  277.     (setq obj_line2 (entlast))
  278.        )
  279.      
  280.      )
  281.    (if (= g_yesorno 1) ;编组
  282.       (progn
  283.        ;建立选择集
  284.        (setq obj_together (ssadd obj_txt (ssadd obj_line2 (ssadd obj_line))))
  285.        ;生成匿名组
  286.        (command "-group" "c" "*" "对象标注" obj_together "")
  287.       )
  288.      )
  289.    (setvar "osmode" var_os);恢复捕捉
  290.    (setvar "clayer" var_old_layer);恢复当前图层
  291.    (princ)
  292.      ;提示选择对象,获得选择点
  293.    (setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))
  294.   );end progn
  295.    
  296. );end while
  297.   (princ)
  298. )













  299. ;; xyp-E2O 将 AutoLISP 类型的对象名转换为 VLA 对象 ename为实体名称 = (car(entsel))
  300. (defun xyp-E2O (ename) (vlax-ename->vla-object ename))
  301. (defun xyp-O2E (oname) (vlax-vla-object->ename oname))
  302. ;; xyp-get-VertexsTrue 删除多段线中直线段上的多余节点
  303. (defun xyp-get-VertexsTrue (ptn / ptn1 p1 p2 p3)
  304.   (setq ptn1 '())
  305.   (while (>= (length ptn) 3)
  306.     (setq p1 (nth 0 ptn)
  307.    p2 (nth 1 ptn)
  308.    p3 (nth 2 ptn)
  309.     )
  310.     (if (< (abs (- (angle p1 p2) (angle p2 p3))) 1e-6)
  311.       (setq ptn (vl-remove p2 ptn))
  312.       (setq ptn1 (cons (car ptn) ptn1)
  313.      ptn  (cdr ptn)
  314.       )
  315.     )
  316.   )
  317.   (append (reverse ptn1) ptn)
  318. )

  319. ;; xyp-get-LispValue vl数据列表 (xyp-get-LispValue safearray)
  320. (defun xyp-get-LispValue (Value)
  321.   (vlax-safearray->list (vlax-variant-value Value))
  322. )

  323. ;; xyp-get-Coordinates mesh或pl实体顶点表 (xyp-get-Coordinates ename)
  324. (defun xyp-get-Coordinates (ename / ob ptn lst n)
  325.   (setq ob  (xyp-e2o ename)
  326. ptn (vla-get-Coordinates ob)
  327. lst '("AcDbPolygonMesh" "AcDbPolyFaceMesh" "AcDb3DPoly" "AcDbLeader" "AcDbPoint" "AcDbSolid" "AcDbTrace" "AcDb2dPolyline" "AcDb3dPolyline")
  328. n   (if (member (vla-get-objectname ob) lst)
  329.        3
  330.        2
  331.      )
  332.   )
  333.   (XYP-LIST-DIV (xyp-Get-LispValue ptn) n)
  334. )


  335. ;; 实例:优化多段线,长度小于500的顶点取消
  336. (defun c:tt ()
  337.   (setq s1  (car (entsel "\n选择多段线: "))
  338. ptn (xyp-get-Vertexs s1 0)
  339. ptn (CheckPtn ptn 500)
  340.   )
  341.   (xyp-Entmake-lwPolyline ptn nil)
  342.   (princ)
  343. )







  344. 按图层输出
  345. ;;;2011年11月8日 15:10:01
  346. ;;;yanshengjiang收集整理
  347. (defun c:tcsc(/ *ERROR* la leng n dwgname lu2 lu work dwgname-lujing wenjian-ls ss);;按图层输出到文件
  348.   (defun *ERROR*(msg)(princ))
  349.     (setvar "cmdecho" 0)
  350.   (INITGET "All Sng")
  351.   (setq work(getkword "\n[全图输出(A)/单一图层输出(S)]    默认(S)"))
  352.   (if (/= "" work)(setq work "All"))
  353.     (setq la(get_all_layer))
  354.     (setq leng(length la))
  355.     (setq dwgname (getvar "dwgname"))
  356.     (setq dwgname-lujing (getvar "DWGPREFIX"))
  357.     (setq lu2(MAKEFOLDER (strcat dwgname-lujing (vl-filename-base dwgname))))
  358.     (setq lu(strcat  dwgname-lujing (vl-filename-base dwgname)"\\"(vl-filename-base dwgname) "_"))
  359. (if (= "All" work)
  360.     (progn
  361.            (command "_.undo" "m");标记
  362.            (command "_.zoom" "e")
  363.            (command "_.purge" "a" "*" "n")
  364.     (setq n 0)
  365.     (while (< n leng)
  366.     (setq wenjian-ls (strcat lu (nth n la)))
  367.       (if (= nil(findfile(strcat wenjian-ls ".dwg")))
  368.            (if(setq ss (ssget "x" (list(cons 8 (nth n la)))))
  369.        (progn
  370.         (command "_.wblock" wenjian-ls "" "0,0" ss "" "oops")
  371.          (princ "\n已经保存到: ")
  372.          (princ wenjian-ls)
  373.       ))
  374.    (princ (strcat "\n已经存在" wenjian-ls ".dwg"))
  375.       )
  376.       (setq n(1+ n))
  377.     )
  378.       (command "_.undo" "b");后退
  379.       );progn
  380.     (progn
  381.       (setq la(cdr(assoc 8(entget(car(entsel"\n请选择您要输出图层上的一个实体:"))))))
  382.       (setq ss(ssget "x" (list(cons 8 la))))
  383.       (if(= nil(findfile(strcat lu la ".dwg")))
  384.        (progn
  385. (command "_.undo" "m");标记
  386. (command "_.zoom" "e")
  387.         (command "_.purge" "a" "*" "n")
  388.         (command "_.wblock" (strcat lu la) "" "0,0" ss "" "oops")
  389. (command "_.undo" "b");后退
  390. (princ(strcat"\n已输出到" lu la))
  391.   )
  392.       (princ (strcat "\n已经存在" lu la ".dwg"))
  393. )
  394.    );progn
  395.   );if
  396.   (princ)
  397.   )

  398. ;==========================================================================
  399.   (defun get_all_layer (/ lay layer2 layname);;;;;得到图层列表。。。by秋枫批打
  400.     (setq layer2 nil         
  401.    lay (tblnext "LAYER" T)
  402.     )
  403.     (while (/= lay nil)
  404.       (setq layname (cdr (assoc 2 lay))
  405.      layer2 (cons layname layer2)
  406.       )
  407.       (setq lay (tblnext "LAYER"))
  408.     )
  409.     (setq layer2 (ACAD_Strlsort layer2))
  410.     layer2         
  411.    )
  412. ;==========================================================================
  413. (defun MAKEFOLDER (FNAME / SYS FOLDER);建立文件夹;;;By LUCAS(龙龙仔)
  414.    (if (not (findfile FNAME))
  415.        (progn
  416.            (setq SYS (vlax-create-object "Scripting.FileSystemObject"))
  417.            (setq FOLDER (vlax-invoke-method SYS 'CREATEFOLDER FNAME))
  418.            (vlax-put  FOLDER
  419.     "Attributes"
  420.     1        ;此处如果改成2.则创建隐藏文件夹
  421.            )
  422.            (vlax-release-object FOLDER)
  423.            (vlax-release-object SYS)
  424.        )
  425. ;;;       (alert (strcat "\"" FNAME "\" 档案夹已存在!!"))
  426.    )
  427.    (princ)
  428. )

  429. ;;交点列表[ss-选择集]
  430. (defun yad_inters(ss / n n1 obj1 n2 obj2 ipt l_pt)
  431.   (setq        n (sslength ss)
  432.         n1 0
  433.   )
  434.   (while (< n1 (1- n))
  435.     (setq obj1 (vlax-ename->vla-object (ssname ss n1))
  436.           n2 (1+ n1)
  437.     )
  438.     (while (< n2 n)
  439.       (setq obj2 (vlax-ename->vla-object (ssname ss n2))
  440.             ipt  (vlax-variant-value (vla-intersectwith obj1 obj2 0))
  441.       )
  442.       (if (> (vlax-safearray-get-u-bound ipt 1) 0)
  443.         (progn
  444.           (setq ipt (vlax-safearray->list ipt))
  445.           (while (> (length ipt) 0)
  446.             (setq l_pt (cons (list (car ipt) (cadr ipt) (caddr ipt)) l_pt) ipt (cdddr ipt))
  447.           )
  448.         )
  449.       )
  450.       (setq n2 (1+ n2))
  451.     )
  452.     (setq n1 (1+ n1))
  453.   )
  454.   l_pt
  455. )
  456. ;;复合线顶点列表[en-复合线对象名或对象数据列表]
  457. (defun yad_ptlst(en / n l_pt l_p)
  458.   (if (not (listp en)) (setq en (entget en)))
  459.   (setq n (vl-position (assoc 10 en) en))
  460.   (repeat (- (length en) n)
  461.     (if (= (car (nth n en)) 10)
  462.       (setq l_pt (append l_pt (list (cdr (nth n en)))))
  463.     )
  464.     (setq n (1+ n))
  465.   )
  466.   (foreach n l_pt
  467.     (if (not (vl-member-if '(lambda(x) (equal x n 0.01)) l_p))
  468.       (setq l_p (append l_p (list n)))
  469.     )
  470.   )
  471.   l_p
  472. )
  473. ;;复合线转折点列表[l_pt-复合线顶点列表]
  474. (defun yad_cptlst(l_pt / l_pv p1 p2 ang ang1 n p pd)
  475.   (setq l_pt (append l_pt (list (car l_pt)))
  476.         l_pv (list (setq p1 (nth 0 l_pt)) (setq p2 (nth 1 l_pt)))
  477.         ang (angle p1 p2)
  478.         ang1 ang
  479.         n 2
  480.   )
  481.   (while (setq p (nth n l_pt))
  482.     (setq pd p2)
  483.     (if (equal ang (angle p2 p) 0.01)
  484.       (setq l_pv (subst p p2 l_pv)
  485.             p2 p
  486.       )
  487.       (setq ang (angle p2 p)
  488.             p2 p
  489.             l_pv (append l_pv (list p))
  490.       )
  491.     )
  492.     (setq n (1+ n))
  493.   )
  494.   (if (equal ang1 (angle pd p2) 0.01)
  495.     (setq l_pv (vl-remove p2 l_pv))
  496.     (setq l_pv (reverse (cdr (reverse l_pv))))
  497.   )
  498.   l_pv
  499. )
  500. ;;求屏幕两对角点
  501. (defun yad_viewpt(/ a b c d x)
  502.   (setq b (getvar "viewsize")
  503.         c (car (getvar "screensize"))
  504.         d (cadr (getvar "screensize"))
  505.         a (* b (/ c d))
  506.         x (trans (getvar "viewctr") 1 2)
  507.         c (trans (list (- (car x)  (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0) 2 1)
  508.         d (trans (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) 2 1)
  509.   )
  510.   (list c d)
  511. )
  512. ;;生成无名组[lst-要成组的对象列表]
  513. (defun yad_group(lst / en1 name en ent)
  514.   (setq lst (mapcar '(lambda(e) (cons 340 e)) lst))
  515.   (setq en1 (dictsearch (namedobjdict) "ACAD_GROUP"))
  516.   (if (member (cons 3 "*A1") en1)
  517.     (setq name (strcat "*A" (itoa (1+ (atoi (substr (cdr (assoc 3 (reverse en1))) 3))))))
  518.     (setq name "*A1")
  519.   )
  520.   (setq en (list (cons 0 "GROUP") (cons 102 "{ACAD_REACTORS")
  521.                  (cons 330 (dxf en1 -1)) (cons 102 "}")
  522.                  (cons 100 "AcDbGroup") (cons 70 1) (cons 71 1)
  523.             )
  524.   )
  525.   (setq ent (entmakex (append en lst))
  526.         en1 (append en1 (list (cons 3 name) (cons 350 ent)))
  527.   )
  528.   (entmod en1)
  529. )
  530. ;;缩放屏幕确保对象在屏幕内[lst-对象顶点列表]
  531. (defun yad_zoom(lst / maxmin lsttrans a b zmpt)
  532.   (defun maxmin(lst / x n a b c d)
  533.     (setq x (car lst)
  534.           a (car x)
  535.           b (cadr x)
  536.           c (car x)
  537.           d (cadr x)
  538.           n 1
  539.     )
  540.     (repeat (max (- (length lst) 1) 0)
  541.       (setq x (nth n lst)
  542.             a (min a (car x))
  543.             b (min b (cadr x))
  544.             c (max c (car x))
  545.             d (max d (cadr x))
  546.             n (1+ n)
  547.       )
  548.     )
  549.     (list (list a b) (list c d))
  550.   )
  551.   (defun lsttrans(lst a b / lst2 c n)
  552.     (setq n 0)
  553.     (repeat (length lst)
  554.       (setq c (trans (nth n lst) a b)
  555.             lst2 (append lst2 (list c))
  556.             n (1+ n)
  557.       )
  558.     )
  559.     lst2
  560.   )
  561.   (setq lst (maxmin (lsttrans lst 1 2))
  562.         a (car lst)
  563.         b (cadr lst)
  564.         lst (list (list (- (car a) 4000) (- (cadr a) 4000)) (list (+ (car b) 4000) (+ (cadr b) 4000)))
  565.         a (maxmin (lsttrans (viewpnts) 1 2))
  566.         b (maxmin (append a lst))
  567.         zmpt (list (trans (append (car b) '(0.0)) 2 1) (trans (append (cadr b) '(0.0)) 2 1))
  568.   )
  569.   (command "_.zoom" "_w" (car zmpt) (cadr zmpt))
  570.   zmpt
  571. )
  572. ;;检查对话框输入数值的合法性[title-对话框 maxint-最大值 minint-最小值 oldval-原来的值]
  573. (defun yad_chkval(title maxint minint oldval / val)
  574.   (setq val (atof (get_tile title)))
  575.   (if (>= maxint val minint)
  576.     (set_tile title (rtos val))
  577.     (set_tile title oldval)
  578.   )
  579. )
  580. ;;检查整数输入的合法性[pmt-提示 defval-缺省值 maxint-最大值 minint-最小值]
  581. (defun yad_chkint(pmt defval maxint minint / val pd)
  582.   (if (/= defval "no") (setq pmt (strcat pmt "<" defval ">") defval (atoi defval)))
  583.   (setq pd T)
  584.   (while (and pd (setq val (getint pmt)))
  585.     (if (>= maxint val minint)
  586.       (setq pd nil val val)
  587.       (prompt "输入无效!")
  588.     )
  589.   )
  590.   (if (and (/= defval "no") (not val)) (setq val defval))
  591.   (if (>= maxint val minint)
  592.     val
  593.     (if (/= defval "no")
  594.       (prompt "\n缺省值无效!")
  595.     )
  596.   )
  597. )
  598. ;;选择集合并[oldss-原选择集 ss-被合并的选择集]
  599. (defun yad_ssadd(oldss ss / n)
  600.   (setq n -1)
  601.   (repeat (sslength ss)
  602.     (ssadd (ssname ss (setq n (1+ n))) oldss)
  603.   )
  604.   oldss
  605. )
  606. ;;选择点特征的对象[dis-允许的距离范围 x-序号列表 y-点列表 z-其它过滤列表]
  607. (defun yad_ssget(dis x y z / n m)
  608.   (setq z (append z '((-4 . "<or"))))
  609.   (setq n 0)
  610.   (repeat (length x)
  611.     (setq m 0)
  612.     (repeat (length y)
  613.       (setq z (append z (list(cons -4 "<and")
  614.                              (cons -4 "<=,<=")
  615.                              (cons (nth n x)
  616.                                    (mapcar '(lambda(e) (+ e dis)) (nth m y))
  617.                              )
  618.                              (cons -4 ">=,>=")
  619.                              (cons (nth n x)
  620.                                    (mapcar '(lambda(e) (- e dis)) (nth m y))
  621.                              )
  622.                              (cons -4 "and>")
  623.                         )
  624.               )
  625.       )
  626.       (setq m (1+ m))
  627.     )
  628.     (setq n (1+ n))
  629.   )
  630.   (setq z (append z '((-4 . "or>"))))
  631.   (ssget "x" z)
  632. )
  633. ;;修改对象[en-对象名或对象数据列表 n-序号 new-新值]
  634. (defun yad_chgent(en n new)
  635.   (if (not (listp en)) (setq en (entget en)))
  636.   (if (assoc n en)
  637.     (setq en (subst (cons n new) (assoc n en) en))
  638.     (setq en (append en (list (cons n new))))
  639.   )
  640.   (entmod en)
  641. )
  642. ;;删除表的指定位置项[nm-位置 lst-表]
  643. (defun yad_remove(nm lst / n newlst)
  644.   (setq n 0)
  645.   (repeat (length lst)
  646.     (if (/= nm n)
  647.       (setq newlst (append newlst (list (nth n lst))))
  648.     )
  649.     (setq n (1+ n))
  650.   )
  651.   newlst
  652. )
  653. ;;字符串转列表[str-字符串 st-标志字符]
  654. (defun yad_str2lst(str st / lst)
  655.   (setq str (strcat str st))
  656.   (while (vl-string-search st str)
  657.     (setq lst (append lst (list (substr str 1 (vl-string-search st str)))))
  658.     (setq str (substr str (+ (1+ (strlen st)) (vl-string-search st str))))
  659.   )
  660.   (if lst (mapcar '(lambda(e) (vl-string-trim " " e)) lst))
  661. )
  662. ;;直接使用ACAD命令
  663. (defun yad_comd()
  664.   (setvar "cmdecho" 1)
  665.   (while (/= 0 (getvar "cmdactive")) (command pause))
  666.   (setvar "cmdecho" 0)
  667. )


  668. ;; ! ***************************************************************************
  669. ;; ! xd_GetObjectBoundingBox
  670. ;; ! ***************************************************************************
  671. ;; ! 功  能  : 返回实体包围盒的对角点.
  672. ;; ! 参  数  : 'ename' - Any Drawing Object
  673. ;; ! 返回值  : 'Lst' - is a list of LL and UR
  674. ;; ! 说  明  : 适用 AutoCAD 2000+
  675. ;; ! e-mail  : eachy@xdcad.net
  676. ;; ! Web     : www.xdcad.net
  677. ;; ! ****************************************************************************
  678. (defun xd_GetObjectBoundingBox (ename / ll ur)
  679.   (vla-GetBoundingBox (vlax-ename->vla-object ename) 'll 'ur)
  680.   (list
  681.     (vlax-safearray->list ll)
  682.     (vlax-safearray->list ur)
  683.   )
  684. )
  685. ;; ! ***************************************************************************
  686. ;; ! xd_GetSSBoundingBox
  687. ;; ! ***************************************************************************
  688. ;; ! 功  能  : 返回选择集实体包围盒的对角点.
  689. ;; ! 参  数  : 'ss' - Any Drawing Object Selection
  690. ;; ! 返回值  : 'Lst' - is a list of LL and UR
  691. ;; ! 说  明  : 适用 AutoCAD 2000+
  692. ;; ! e-mail  : eachy@xdcad.net
  693. ;; ! Web     : www.xdcad.net
  694. ;; ! ****************************************************************************
  695. (defun xd_getSSBoundingbox (ss / ssl i ptl)
  696.   (setq        ssl (sslength ss)
  697.         i   -1
  698.   )
  699.   (repeat ssl
  700.     (setq
  701.       ptl (cons        (xd_getObjectboundingbox (ssname ss (setq i (1+ i))))
  702.                 ptl
  703.           )
  704.     )
  705.   )
  706. ;;;  (xd-points_box (apply 'append ptl))
  707. )

  708. ;;;=============================================================================
  709. ;;;关闭所有的浏览器进程                                                         
  710. ;;;=============================================================================
  711. (defun C:GB()
  712.   (defun Close_All_IExplore (EXENAME / SWbemLocator WQL Service IEProcesses isClosed)
  713.     (setq SWbemLocator (vlax-create-object "WbemScripting.SWbemLocator"))
  714.     (setq Service (vlax-invoke SWbemLocator 'ConnectServer))
  715.     (setq WQL (strcat "SELECT * FROM Win32_Process WHERE Name='" ExeName ".EXE'" ))
  716.     (setq IEProcesses (vlax-invoke Service 'ExecQuery WQL))
  717.     (vlax-for IE IEProcesses
  718.        (vlax-invoke IE 'Terminate)
  719.     )
  720.     (vlax-release-object IEProcesses)
  721.     (vlax-release-object Service)
  722.     (vlax-release-object SWbemLocator)
  723.   )  
  724.   (VL-CATCH-ALL-APPLY
  725.     'mapcar
  726.     (list 'Close_All_IExplore
  727.    (list "IEXPLORE" "360se" "360chrome" "chrome" "opera" "firefox") ;还有什么浏览器自己添加吧!
  728.     )
  729.   )
  730.   (princ)
  731. )

  732. ;;删除列表中的相同元素(保留一个)并返回新表
  733. (defun LstDelSame( Lst / Lst1 n)
  734. (setq Lst1 '())
  735. (foreach n Lst
  736.     (if (not (member n Lst1))
  737.         (setq Lst1 (cons n Lst1))
  738.     )
  739. )
  740. (reverse Lst1)
  741. )

  742. (defun delsame (lst) (if lst (cons (car lst) (delsame (vl-remove (car lst) lst)))))


  743. ;----------------------------------------------------------------------
  744. ;----------------------------------------------------------------------
  745. ;1.取pline,lwpline点坐标表
  746. ; 支持pline,lwpline
  747. ;测试: (vxs (car(entsel "\n 选多义线:")))
  748. ;By 无痕
  749. (defun vxs  (e / i v lst)
  750.    (setq i -1)
  751.    (while
  752.   (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
  753.       (setq lst (cons v lst))
  754.    )(reverse lst)
  755. )

  756. ;----------------------------------------------------------------------
  757. ;----------------------------------------------------------------------
  758. ;2. 从点列表(point list)得到坐标范围
  759. ;例如: (GetExtents '((1 0 0) (2 2 0) (1 2 0)))

  760. (defun GetExtents (plist /)
  761.   (list
  762.     (apply 'mapcar (cons 'min plist))
  763.     (apply 'mapcar (cons 'max plist))
  764.   )
  765. )
  766. ;----------------------------------------------------------------------
  767. ;----------------------------------------------------------------------
  768. ;3.将字符串分割为表
  769. ;By 无痕
  770. ;a-vlisp方法

  771. ;(str2lst str) 将输入的数据转换为字符串列表.-----------------------------梁雄啸.2004.3
  772. ;测试: (str2lst  "Hello 2World 12 5456.1568") = ("Hello" "2World" "12" "5456.1568")
  773. ;版权所有,盗用必究!如在程序中引用,请保留文字信息行.
  774. (defun str2lst (str / i)
  775.    (while (setq i (vl-string-search " " str (if i (+ 2 i) 0)))
  776.      (setq str (vl-string-subst "\"\"" " " str i))
  777.    )(read (strcat "(\"" str "\")"))
  778. )
  779. ;
  780. ;(str2lst str) 将输入的数据转换为字符串列表.v1b-----------------梁雄啸.2004.3
  781. ;测试:  (str2lst  "Hello 2World 12 5456.1568")  -> ("Hello" "2World" "12" "5456.1568")
  782. ;版权所有,盗用必究!如在程序中引用,请保留文字信息行.
  783. (defun str2lst (str /)
  784.    (read(vl-list->string
  785.    (apply 'append(mapcar '(lambda (x)(if (= 32 x) (list 34 32 34) (list x)))(append (list 40 34)(vl-string->list str)(list 34 41))))
  786.    )    )
  787. )

  788. ;b-autolisp方法

  789. ;(str2lst str) 将输入的数据转换为字符串列表.---(纯autolspl的写法)--------------------------梁雄啸.2004.3
  790. ;测试: (str2lst  "Hello 2World 12 5456.1568") = ("Hello" "2World" "12" "5456.1568")
  791. ;版权所有,盗用必究!如在程序中引用,请保留文字信息行.
  792. (defun str2lst (str / i strlst str1)
  793.    (setq i 0 str1 "")
  794.    (while (/= "" (setq s (substr str (setq i (1+ i)) 1)))
  795.      (cond ((/= " " s) (setq str1 (strcat str1 s)))
  796.            (T (setq strlst (append strlst (list str1))
  797.              str1 "")))
  798.    )(if (/= str1 "") (append strlst (list str1)) strlst)
  799. )
  800. ;方法2:
  801. (defun str2lst (str / i str1)
  802.    (setq i 0 str1 "")
  803.    (while (/= "" (setq s (substr str (setq i (1+ i)) 1)))
  804.      (setq str1 (strcat str1 (if (= " " s) "\" \"" s)))
  805.    )(read (strcat "(\"" str1 "\")"))
  806. )
  807. ;----------------------------------------------------------------------
  808. ;----------------------------------------------------------------------
  809. ;4.剔除表元素
  810. ;By 无痕

  811. ;| (x:removeat at lst ) = 表剔除元素;-------------无痕.2004.1
  812. ;提示; 等同于: (vl-remove  element-to-remove  list)
  813.   (x:removeat "a" '(58 3 (a . 8) "a" 4.5)) -> (58 3 (A . 8) 4.5)
  814. |;
  815. (defun x:removeat (at lst) ;at=atom
  816.    (apply 'append (subst nil (list at) (mapcar 'list lst)))
  817. )
  818. ;----------------------------------------------------------------------
  819. ;----------------------------------------------------------------------
  820. ;5.炸开嵌套块

  821. ;xex = 炸开嵌套块.-----by 无痕.2004.4
  822. (defun c:xex ()
  823.    (princ "\n炸开嵌套块.--------------by 无痕.2004.4")
  824.    (setvar "qaflags" 1)
  825.    (setq ss (ssget '((0 . "INSERT"))))
  826.    (while (setq ss (ssget "" '((0 . "INSERT"))))
  827.      (command ".explode" ss "")
  828.    )(princ)
  829. )
  830. ;----------------------------------------------------------------------
  831. ;----------------------------------------------------------------------
  832. ;6.对表分段

  833. ;|(xl_div lst nom)表分段. -> 返回 分段的表.   ------by 无痕.2004.1
  834. ; lst = 表,nom = 分段的子表元素个数(从1开始计).
  835. ; 测试: (xl_div '(1 2 3 4 5 6 7 8 9) 3) -> ((1 2 3) (4 5 6) (7 8 9))
  836.          (xl_div '(1 2 3 4 5 6 7 8 9 10 11) 3) -> ((1 2 3) (4 5 6) (7 8 9) (10 11))
  837.          (xl_div '(17086.8 5666.8 0.0 16093.0 8693.12 0.0 16093.0 7827.36 0.0 16093.0 6639.13 0.0) 3)
  838.          -> ((17086.8 5666.8 0.0) (16093.0 8693.12 0.0) (16093.0 7827.36 0.0) (16093.0 6639.13 0.0))
  839.          (xl_div nil 2) -> nil
  840. |;
  841. ;方法7. ok!**************************************************
  842. (defun xl-div (lst x / lst2)
  843.    (foreach n lst
  844.      (if (and  lst2 (/= x (length (car lst2))))   
  845.   (setq lst2 (cons (append (car lst2)(list n))(cdr lst2)))
  846.   (setq lst2 (cons (list n) lst2))
  847.      )
  848.    )(reverse lst2)
  849. )
  850. ;----------------------------------------------------------------------
  851. ;----------------------------------------------------------------------
  852. ;7.取线的<起点>,<中点>,<终点>
  853. ;By 无痕
  854. ;适用所有曲线

  855. (DEFUN xl-3p (e / ps pe pm)
  856.    (setq ps (vlax-curve-getstartparam e)
  857.          pe (vlax-curve-getendparam e)
  858.          pm (/ (- pe ps) 2))
  859.    (mapcar 'vlax-curve-getpointatparam (list e e e) (list ps pm pe))
  860. )
  861. ;----------------------------------------------------------------------
  862. ;----------------------------------------------------------------------
  863. ;8.求点集中最远,最近点表
  864. ;By 无痕

  865. ;|求点集中最远,最近点表.
  866. 返回最远两点 最近两点)
  867.   (xpts-lensort (while (setq pt(getpoint)) (setq plst (cons pt plst)))))
  868.   ->(((14857.8 -599.932 0.0) (26695.2 -3687.68 0.0)) ((15733.8 -3687.68 0.0) (15630.7 -3842.07 0.0)))
  869. |;
  870. (defun xpts-lensort (ptlst / pt d maxd mind maxl minl)
  871.   (setq minl (list (car ptlst)(cadr ptlst)) maxd 0 mind (apply 'distance minl))
  872.   (while (setq pt (car ptlst) ptlst (cdr ptlst))
  873.     (foreach n ptlst
  874.       (setq d (distance n pt))
  875.       (cond ((< maxd d)(setq maxd d maxl (list n pt)))
  876.      ((> mind d)(setq mind d minl (list n pt)))
  877.       )
  878.     )
  879.   )(list maxl minl)
  880. )

  881. ;----------------------------------------------------------------------
  882. ;----------------------------------------------------------------------
  883. ;9..表与选择集之间转换
  884. ;By caiqs
  885. ;;;选择集变表 2007/8/30 师兄 QQ 361865648
  886. (defun ss->lst (ss / retu)
  887.   (setq retu (apply 'append (ssnamex ss)))
  888.   (setq retu (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) retu))
  889. )
  890. ;;;测试
  891. (setq ss (ssget));_构建选择集
  892. (princ (ss->lst ss))
  893. ;;;表变选择集 2007/8/30 师兄 QQ 361865648
  894. (defun lst->ss(lst / ss)
  895.   (setq ss(ssadd))
  896.   (last(mapcar '(lambda (x) (ssadd x ss)) lst)))
  897. ;;;测试
  898. (setq lst(list (car(entsel)) (car(entsel))))
  899. (lst->ss lst)

  900. ;; 设置当前图层为0
  901. (defun C:0 (/ ss)
  902.   (command "._Clayer" "0")
  903.   (princ)
  904. )
  905. ;; 设置当前颜色号为1
  906. (defun C:1 (/ ss)
  907.   (command "._Cecolor" 1)
  908.   (princ)
  909. )
  910. (defun C:695 ()
  911.   (princ "\n常用捕捉")
  912.   (setvar "OSMODE" 695)
  913.   (princ)
  914. )

  915. ;; 镜像不删源
  916. (defun C:MMN (/ ss)
  917.   (and (setq ss (ssget))
  918.        (not (command "._mirror" ss "" pause pause "n"))
  919.   )
  920.   (princ)
  921. )
  922. ;; 镜像删除源
  923. (defun C:MMY (/ ss)
  924.   (and (setq ss (ssget))
  925.        (not (command "._mirror" ss "" pause pause "y"))
  926.   )
  927.   (princ)
  928. )

  929. ;; 命令: TCU
  930. ;; 思路: 1. 选择对象,取得对象的图层
  931. ;;       2. 通用对象的图层,过滤选择整个图形中,图层相同的对象
  932. ;;       3. 调用绘图顺序的命令,执行程序
  933. (defun C:TCU (/ E LAYER MSG OPTION SS)
  934.   (princ "\n根据图层改变对象绘图顺序")
  935.   (initget "A U F B")
  936.   (setq msg "\n排序选项 [对象上(A)/对象下(U)/最前(F)/最后(B)] <最后>: ")
  937.   (setq option (getkword msg))
  938.   (or option (setq option "B"))
  939.   (while (and (setq e (car (entsel)))
  940.        (setq layer (cdr (assoc 8 (entget e))))
  941.        (setq ss (ssget "X" (list (cons 8 layer))))
  942.        (not (command "_.Draworder" ss "" option))
  943.   )
  944.   )
  945.   (princ "\n作者: 蔡建伟 QQ: 95818608")
  946.   (princ)
  947. )

  948. ;; 命令: QQ
  949. ;; 功能: 连接直线、圆弧、多段线 转为 多段线
  950. ;; 备注: 支持二维多段线
  951. (defun C:QQ (/ PAT SS)
  952.   (setvar "CMDECHO" 0)
  953.   (princ "\n连接直线、圆弧、多段线 转为 多段线")
  954.   (setq PAT (getvar "PEDITACCEPT"))
  955.   (setvar "PEDITACCEPT" 1)
  956.   (if (setq SS (ssget '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE"))))
  957.     (vl-catch-all-apply
  958.       '(lambda ()
  959.          (command "._Convert" "P" "S" SS "")
  960.          (command "._Pedit" "M" SS "" "J" "1" "")
  961.          (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
  962.        )
  963.     )
  964.   )
  965.   (setvar "PEDITACCEPT" PAT)
  966.   (princ "\n作者: 蔡建伟 QQ:95818608")
  967.   (princ)
  968. )
  969. ;; 实现CAD2004的“重复复制”
  970. ;; 当然,在CAD2006及以上的版本就没有这个麻烦
  971. (defun C:C (/ SS)
  972.   (setvar "cmdecho" 0)
  973.   (if (setq SS (ssget))
  974.     (command "_.copy" SS "" "m")
  975.   )
  976.   (princ)
  977. )

  978. ;; 命令: CR
  979. ;; 思路: 1. 选择对象
  980. ;;       2. 复制对象
  981. ;;       3. 旋转对象
  982. (defun C:CR (/ E PT SS SS1)
  983.   (princ "\n复制旋转")
  984.   (while (and (setq E (entlast))
  985.               (setq SS (ssget))
  986.               (setq SS1 (ssadd))
  987.          )
  988.     (progn
  989.       (command "_.COPY" SS "")
  990.       (while (= (getvar "CMDNAMES") "COPY")
  991.         (command PAUSE)
  992.       )
  993.       (while (setq E (entnext E))
  994.         (ssadd E SS1)
  995.       )
  996.       (if (setq PT (getvar "LASTPOINT"))
  997.         (progn
  998.           (command "_.ROTATE" SS1 "" "_NON" PT)
  999.           (while (= (getvar "CMDNAMES") "ROTATE")
  1000.             (command PAUSE)
  1001.           )
  1002.         )
  1003.       )
  1004.     )
  1005.   )
  1006.   (princ "\n作者: 蔡建伟 QQ:95818608")
  1007.   (princ)
  1008. )

  1009. ;; 这里介绍一下
  1010. ;; (command "._UNDO" "_BEGIN")
  1011. ;; (command "._UNDO" "_END")
  1012. ;; 这两句一般放在程序的首尾,其作用相当于告诉CAD有一个记号。
  1013. ;; 在使用命令: U 的时候,会跳过BEGIN和END的中间环节。
  1014. ;; 功能: 多个多段线圆角
  1015. ;; 命令: YJ
  1016. (defun C:YJ (/ E FILLETRAD I RAD SS)
  1017.   ;; UNDO 开始
  1018.   (command "._UNDO" "_BEGIN")
  1019.   (princ "\n多个多段线圆角")
  1020.   (setq RAD (getdist "\n指定圆角的半径<65>: "))
  1021.   ;; 设置默认圆角半径值
  1022.   (if (null RAD)
  1023.     (setq RAD 65)
  1024.   )
  1025.   (if (setq SS (ssget '((0 . "LWPOLYLINE"))))
  1026.     (progn
  1027.       ;; 圆角半径变量
  1028.       (setq FILLETRAD (getvar "FILLETRAD"))
  1029.       (setvar "FILLETRAD" RAD)
  1030.       ;; 循环
  1031.       (repeat (setq I (sslength SS))
  1032.         (setq E (ssname SS (setq I (1- I))))
  1033.         ;; 圆角多段线
  1034.         (command "._FILLET" "P" E)
  1035.       )
  1036.       (setvar "FILLETRAD" FILLETRAD)
  1037.     )
  1038.   )
  1039.   (princ "\n作者: 蔡建伟 QQ:95818608")
  1040.   ;; UNDO 结束
  1041.   (command "._UNDO" "_END")
  1042.   (princ)
  1043. )

  1044. ;; 命令: BT
  1045. ;; 功能: 打断于点
  1046. ;; 备注: 注意用command调用BREAK命令与其它命令不太一样。
  1047. (defun C:BT (/ ENT PT)
  1048.   (while (and (setq ENT (car (entsel)))
  1049.               (setq PT (getpoint "\n指定一个打断点: "))
  1050.          )
  1051.     (command "._BREAK" ENT "_NON" PT "_NON" PT)
  1052.   )
  1053.   (princ "\n作者: 蔡建伟 QQ: 95818608")
  1054.   (princ)
  1055. )

  1056. ;; 命令: OO
  1057. ;; 功能: 偏移后将原曲线删除
  1058. ;; 备注: *tt:dis 为全局变量 (用于记忆上一次输入值)
  1059. ;;       所以没有放在(/ dis ent pt) / 后面
  1060. ;;       放在 / 后面的为局部变量,程序结束后变量值自动清空
  1061. (defun C:OO (/ dis ent pt)
  1062.   (princ "\n偏移后将原曲线删除")
  1063.   (if *tt:dis
  1064.     *tt:dis
  1065.     (setq *tt:dis 100.)
  1066.   )
  1067.   (setq dis *tt:dis)
  1068.   (while (and
  1069.            (setvar "ERRNO" 0)
  1070.            (not (initget "D"))
  1071.            (if (setq ent (entsel (strcat "\n>>>当前偏移距离 = "
  1072.                                          (vl-prin1-to-string *tt:dis)
  1073.                                          "\n选择对象[设置偏移距离(D)]: "
  1074.                                  )
  1075.                          )
  1076.                )
  1077.              t
  1078.              (setq ent "D")
  1079.            )
  1080.            (if (= (getvar "ERRNO") 7)
  1081.              nil
  1082.              t
  1083.            )
  1084.          )
  1085.     (cond
  1086.       ((= ent "D")
  1087.        (setq dis (getdist (strcat "\n指定偏移距离<"
  1088.                                   (vl-prin1-to-string *tt:dis)
  1089.                                   ">: "
  1090.                           )
  1091.                  )
  1092.        )
  1093.        (if (null dis)
  1094.          (setq dis *tt:dis)
  1095.          (setq *tt:dis dis)
  1096.        )
  1097.       )
  1098.       ((and (listp ent)
  1099.             (setq pt (getpoint "\n指定要偏移的那一侧上的点<退出>: "))
  1100.        )
  1101.        (command "._offset" dis ent "none" pt "")
  1102.        (entdel (car ent))
  1103.       )
  1104.     )
  1105.   )
  1106.   (princ "\n作者: 蔡建伟 QQ: 95818608")
  1107.   (princ)
  1108. )

  1109. ;; 命令: TN
  1110. ;; 功能: 取得图元对象的DXF组码数据值
  1111. ;; 备注: 图元的数据值可以看到图元的很多特性、属性值。
  1112. (defun C:TN (/ E ELIST)
  1113.   (princ "\n图元数据")
  1114.   (if (and (setq E (car (entsel)))
  1115.            (setq ELIST (entget E '("*")))
  1116.       )
  1117.     (progn
  1118.       (foreach X ELIST
  1119.         (print X)
  1120.       )
  1121.       (textscr)
  1122.     )
  1123.   )
  1124.   (princ "\n作者: 蔡建伟 QQ: 95818608")
  1125.   (princ)
  1126. )

  1127. ;; 命令: TX
  1128. ;; 功能: 查看对象的VLA的属性及方法
  1129. ;; 介绍: (vl-load-com) 用于加载VLA扩展函数
  1130. ;;       如果出现提示 VLA开头的函数不能使用,那就是没有加这一句
  1131. ;;       VL函数是在CAD2000以后才出现的,在此之前是没有的。
  1132. ;; 题外: AutoLisp 和 Visual LISP 区别: 简单的认为 AutoLisp是基础 Visual LISP 是高级
  1133. ;;       简单认为带有VL开头的函数属于 Visual LISP
  1134. (defun C:TX (/ E O)
  1135.   (princ "\n对象特性")
  1136.   (vl-load-com)
  1137.   (if (and (setq E (car (entsel)))
  1138.            (setq O (vlax-ename->vla-object E))
  1139.       )
  1140.     (progn
  1141.       (vlax-dump-object O t)
  1142.       (textscr)
  1143.     )
  1144.   )
  1145.   (princ "\n作者: 蔡建伟 QQ: 95818608")
  1146.   (princ)
  1147. )
  1148. ;; VLA函数功能都可以在(ActiveX) VBA 帮助中找到
  1149. ;; 用此Lisp可知道对象可执行的属性及方法


  1150. (princ
  1151. "\nAuthor: bano
  1152. \n孤帆修改---命令:zbz"
  1153. )
  1154. (defun c:zbz (/ zxlayer ss sspline sszx i en)
  1155. (setq zxlayer "*AXIS*,*DOTE*")
  1156. (princ "\n-------选择需要标注的对象及所用的轴网*AXIS*,*DOTE*-------:")
  1157. (setq  ss  (ssget)
  1158.   sspline  (ssadd)
  1159.   sszx  (ssadd)
  1160. )
  1161. ;;建立标注所在的图层“定位标注”
  1162. (setq old_lay (getvar "clayer"))
  1163. (if (= (tblobjname "LAYER" "定位标注") nil)
  1164. (progn
  1165. (entmake (list
  1166.     '(0 . "LAYER")
  1167.     '(100 . "AcDbSymbolTableRecord")
  1168.     '(100 . "AcDbLayerTableRecord")
  1169.     '(6 . "CONTINUOUS")
  1170.     '(62 . 3)
  1171.     '(70 . 0)
  1172.     (cons 2 "定位标注")
  1173.    )
  1174. )
  1175. )
  1176. )
  1177. (setvar "clayer" "定位标注")
  1178. (setq i -1)
  1179. (repeat (sslength ss)
  1180. (setq en (ssname ss (setq i (1+ i))))
  1181. (if  (wcmatch (cdr (assoc 8 (entget en))) zxlayer)
  1182. (ssadd en sszx)
  1183. )
  1184. (if  (and (= (cdr (assoc 0 (entget en))) "LWPOLYLINE") (>= (cdr (assoc 90 (entget en))) 4))
  1185. (ssadd en sspline)
  1186. )
  1187. )
  1188. (setq interss (getinter (gt:ttt sszx)));获取所有轴线交点坐标
  1189. (gt:tt sspline) ;对柱进行两边标注
  1190. )
  1191. ;;;------------次函数gt:getlayer---------------------------;;;
  1192. ;;;----------获取点选元素所在的图层并返回图层名称----------;;;
  1193. ;|(defun gt:getlayer (/ zx layer)
  1194. (setq zx nil)
  1195. (while (= zx nil)
  1196. (setq zx (entsel "\n选择轴线图层:"))
  1197. )
  1198. (setq  layer
  1199.    (cdr (assoc 8 (entget (car zx))))
  1200. )
  1201. (setq zx nil)
  1202. (princ "\n选中的轴线图层是:")
  1203. (prin1 layer)
  1204. )|;
  1205. ;;;-------获得传递来的四边形集合然后对两边进行标注-------------;;;
  1206. (defun gt:tt (sspline / OLDOS ss i en ptl p1 p2 p3 p4 p0 pp pz)
  1207. (setvar "CMDECHO" 0)
  1208. (setq OLDOS (getvar "OSMODE"))
  1209. (if (setq SS sspline)
  1210. (progn
  1211. (setvar "OSMODE" 0)
  1212. (setq i -1)
  1213. (repeat (sslength ss)
  1214.   (setq en (ssname ss (setq i (+ 1 i))))
  1215.   (setq ptl (getpline en)
  1216.    p1 (car ptl)
  1217.    p2 (cadr ptl)
  1218.    p3 (caddr ptl)
  1219.    p4 (cadddr ptl)
  1220.   )
  1221.   ;插入轴线交点集合,查找适合的点
  1222. (setq x -1)
  1223.   (repeat (length interss)
  1224.    (setq pp (nth (setq x (+ 1 x)) interss))
  1225.    (if (< (max(distance pp p1)(distance pp p2)(distance pp p3)(distance pp p4)) (distance p1 p3))
  1226.    (setq p0 pp)
  1227.    )
  1228.   )
  1229.   ;若柱内有交点则进行标注
  1230.   (if p0
  1231.    (progn
  1232.    (setq pz (getpz p1 p2 p3 p4))
  1233.    ;;根据最佳点位进行标注
  1234.    (if  (= pz p1)
  1235.    (progn
  1236.     (bz:dimaligned p4 p1 p2 p0)
  1237.     (bz:dimaligned p1 p2 p3 p0)
  1238.    )
  1239.    )
  1240.    (if  (= pz p2)
  1241.    (progn
  1242.     (bz:dimaligned p1 p2 p3 p0)
  1243.     (bz:dimaligned p2 p3 p4 p0)
  1244.    )
  1245.    )
  1246.    (if  (= pz p3)
  1247.    (progn
  1248.     (bz:dimaligned p2 p3 p4 p0)
  1249.     (bz:dimaligned p3 p4 p1 p0)
  1250.    )
  1251.    )
  1252.    (if  (= pz p4)
  1253.    (progn
  1254.     (bz:dimaligned p3 p4 p1 p0)
  1255.     (bz:dimaligned p4 p1 p2 p0)
  1256.    )
  1257.    )
  1258.    )
  1259.   )
  1260. )
  1261. )
  1262. )
  1263. (setvar "OSMODE" OLDOS)
  1264. (setvar "CMDECHO" 1)
  1265. (princ)
  1266. )
  1267. ;;;----------次函数getpz:根据四点,求出最佳标注点----------;;;
  1268. (defun getpz (p1 p2 p3 p4 / pp1 pp2 pp3 pp4 ppz1 ppz2 ppz ppp1 ppp2 pp1y pp2y pp3y pp4y)
  1269. (setq  pp1 p1
  1270.   pp2 p2
  1271.   pp3 p3
  1272.   pp4 p4
  1273.   pp1y (atoi (rtos (*(nth 1 pp1) 100) 2 0))
  1274.   pp2y (atoi (rtos (*(nth 1 pp2) 100) 2 0))
  1275.   pp3y (atoi (rtos (*(nth 1 pp3) 100) 2 0))
  1276.   pp4y (atoi (rtos (*(nth 1 pp4) 100) 2 0))
  1277. )
  1278. ;;求最高点
  1279. (if (> pp1y (max pp2y pp3y pp4y))
  1280. (setq ppz pp1)
  1281. )
  1282. (if (> pp2y (max pp1y pp3y pp4y))
  1283. (setq ppz pp2)
  1284. )
  1285. (if (> pp3y (max pp2y pp1y pp4y))
  1286. (setq ppz pp3)
  1287. )
  1288. (if (> pp4y (max pp2y pp3y pp1y))
  1289. (setq ppz pp4)
  1290. )
  1291. ;;若是水平的柱,则求左上角点
  1292. (if (= ppz nil)
  1293. (progn (if (= pp1y (max pp2y pp3y pp4y))
  1294.    (setq ppp1 pp1)
  1295.    )
  1296.    (if (= pp2y (max pp1y pp3y pp4y))
  1297.    (if (= ppp1 nil) (setq ppp1 pp2) (setq ppp2 pp2))
  1298.    )
  1299.    (if (= pp3y (max pp2y pp1y pp4y))
  1300.    (if (= ppp1 nil) (setq ppp1 pp3) (setq ppp2 pp3))
  1301.    )
  1302.    (if (= pp4y (max pp2y pp3y pp1y))
  1303.    (if (= ppp1 nil) (setq ppp1 pp4) (setq ppp2 pp4))
  1304.    )
  1305. (setq ppz (if (< (nth 0 ppp1)(nth 0 ppp2)) ppp1 ppp2))
  1306. )
  1307. )
  1308. (if ppz ppz)
  1309. )
  1310. ;;; 函数 bz:dimaligned 用来实现单边的两个标注 ;;;
  1311. (defun bz:dimaligned (p1 p2 p3 p0 / point1 point2 point3 point0 p12 angle32)
  1312. (setq  point1 p1
  1313.   point2 p2
  1314.   point3 p3
  1315.   point0 p0
  1316.   p12 (findper p0 p1 p2)
  1317.   angle32 (angle point3 point2)
  1318. )
  1319. (brbz point1 p12 angle32 point2)
  1320. )
  1321. ;;;次函数dxf
  1322. (defun dxf (en dxf)
  1323. (cdr(assoc dxf (entget en)))
  1324. )
  1325. ;;;次函数brbz,根据point1 point2 angle32进行避让标注
  1326. (defun brbz(point1 point2 angle32 point3 / e0 p0 e w ed)
  1327. (setq distance12 (distance point1 point2))
  1328.   (setq distance23 (distance point2 point3))
  1329.   (cond ((and (equal distance12 distance23 5)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
  1330.    (dim point1 point2 angle32 "h1" distance12)
  1331.   (dim point3 point2 angle32 "h2" distance23))
  1332.   ((and (equal distance12 distance23 5)(> angle32 0.785))
  1333.    (dim point1 point2 angle32 "b1" distance12)
  1334.   (dim point3 point2 angle32 "b2" distance23))
  1335.    ((and (< distance12 distance23)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
  1336.          (dim point1 point2 angle32 nil distance12)
  1337.          (dim point3 point2 angle32 "h2" distance23)
  1338.    )
  1339.   ((and (> distance12 distance23)(or(equal angle32 0 0.785)(equal angle32 pi 0.1)))
  1340.    (dim point1 point2 angle32 "h2" distance12)
  1341.   (dim point3 point2 angle32 nil distance23))
  1342.   ((and (< distance12 distance23)(> angle32 0.785))
  1343.    (dim point1 point2 angle32 nil distance12)
  1344.    (dim point3 point2 angle32 "b2" distance23))
  1345.   ((and (> distance12 distance23)(> angle32 0.785))
  1346.    (dim point1 point2 angle32 "b2" distance12)
  1347.    (dim point3 point2 angle32 nil distance23))
  1348.   )
  1349. ) ;;end brbz
  1350. (defun dim (point1 point2 angle32 bh distance123 / )
  1351.   (if (= bh nil)
  1352.     (progn
  1353.   (command "dimlinear"
  1354.    point1
  1355.    point2
  1356.    "t"
  1357.    ;;下面if语句是对标注值进行取整
  1358.    (if (< (ABS(- (* (atoi (rtos (if (> distance123 50)
  1359.           (/ distance123 5)
  1360.          (* distance123 20)
  1361.          )
  1362.          2 0
  1363.        )
  1364.      )
  1365.      5
  1366.      )
  1367.      
  1368.      (if (> distance123 50)
  1369.        distance123
  1370.      (* distance123 100)
  1371.      )
  1372.    )) 0.5)
  1373.    "<>"
  1374.    (*  (atoi (rtos (if  (> distance123 50)
  1375.        (/ distance123 5)
  1376.        (* distance123 20)
  1377.        )
  1378.        2
  1379.        0
  1380.      )
  1381.     )
  1382.     5
  1383.    )
  1384.    );end if
  1385.    "r"
  1386.    (* (/ angle32 pi) 180.0)
  1387.    (polar point1 angle32 (if (> distance123 50) 800 8 ))
  1388. ));end command
  1389.     (progn
  1390.   (command "dimlinear"
  1391.    point1
  1392.    point2
  1393.    "t"
  1394.    bh
  1395.    "r"
  1396.    (* (/ angle32 pi) 180.0)
  1397.    (polar point1 angle32 (if (> distance123 50) 800 8 ))
  1398. )));end command
  1399. ;;获取最近画的标注,判断是否需要避让
  1400. (setq e0 (entlast)
  1401.   p0 (dxf e0 11)
  1402. e (cdr (assoc -2 (tblsearch "block" (dxf e0 2))))
  1403. )
  1404. (while e
  1405. (if (= (dxf e 0) "MTEXT")
  1406.   (setq w  (dxf e 42)
  1407.    e  nil
  1408.   )
  1409.   (setq e (entnext e))
  1410. )
  1411. )
  1412. ;;根据条件进行避让
  1413. (if (> w (- distance123 1))
  1414. (progn
  1415. (setq ed (entget e0); 图元名e0的数据关联表存ed
  1416. ed (subst (cons 11
  1417.        (polar(polar p0
  1418.          (angle point2 point1)
  1419.          (if  (> distance123 50) 350 3.5)
  1420.        )
  1421.          angle32 (if  (> distance123 50) 100 1)
  1422.        )
  1423.      )
  1424.      (assoc 11 ed)
  1425.      ed
  1426.     ); ; ; 更改11
  1427. ed (subst (cons 70 (logior (cdr (assoc 70 ed)) 128))(assoc 70 ed)ed); ; ; 更改70
  1428. )
  1429. (entmod ed)
  1430. )
  1431. )
  1432.   )
  1433. ;;; 函数 findper 根据三点坐标,找某点到其他两点形成线的垂直点 ;;;
  1434. (defun findper(p0 p1 p2 / point0 point1 point2)
  1435. (setq  point0 p0
  1436.   point1 p1
  1437.   point2 p2
  1438. )
  1439. (inters (polar point0 (+(angle point1 point2)(/ pi 2)) 10) point0 point1 point2 nil)
  1440. )
  1441. ;;;根据多线段名获得多线段的端点集合 ;;;
  1442. (defun getpline (plname / pts x)
  1443. (setq pts '())
  1444. (mapcar '(lambda (x)
  1445.    (if (= (car x) 10)
  1446.      (setq pts (cons (cdr x) pts))
  1447.    )
  1448.    )
  1449.    (entget plname)
  1450. )
  1451. (reverse pts)
  1452. )
  1453. ;;;-------获得传递来的轴线集合返回轴线端点集合-------------;;;
  1454. (defun gt:ttt (sszx / ss i en lines)
  1455. (if (setq SS sszx)
  1456. (progn
  1457. (setvar "OSMODE" 0)
  1458. (setq i -1)
  1459. (repeat (sslength ss)
  1460.   (setq en (ssname ss (setq i (1+ i))))
  1461.   (setq lines (append lines (getline en)))
  1462. )
  1463. )
  1464. )
  1465. (if lines lines)
  1466. )
  1467. ;;;-------获得传递来的直线端点集合返回直线所有交点集合-----------;;;
  1468. (defun getinter(line / x y lines inter)
  1469. (setq x 0 y 2
  1470.   lines line)
  1471. (setq inter '())
  1472. (repeat (- (/ (length lines) 2) 1)
  1473. (repeat (- (/ (- (length lines) x) 2) 1)
  1474. (if (inters (nth x lines)(nth (+ x 1) lines)(nth y lines)(nth (+ y 1) lines))
  1475. (setq inter (cons (inters (nth x lines)(nth (+ x 1) lines)(nth y lines)(nth (+ y 1) lines)) inter))
  1476. )
  1477. (setq y (+ y 2))
  1478. )
  1479. (setq x (+ x 2))
  1480. (setq y (+ x 2))
  1481. )
  1482. (reverse inter)
  1483. )
  1484. ;;;根据直线名获得直线的两个端点集合 ;;;
  1485. (defun getline (lname / pts x )
  1486. (setq pts '())
  1487. (mapcar '(lambda (x)
  1488.    (if (or (= (car x) 10) (= (car x) 11))
  1489.      (setq pts (cons (3dPoint->2dPoint(cdr x)) pts))
  1490.    )
  1491.    )
  1492.    (entget lname)
  1493. )
  1494. (reverse pts)
  1495. )
  1496. ;;; 函数:3Dpoint->2Dpoint
  1497. (defun 3dPoint->2dPoint  (3dpt)
  1498. (list (float (car 3dpt)) (float (cadr 3dpt)))
  1499. )

  1500. (vl-load-com)
  1501. (setq *acad* (vlax-get-acad-object))
  1502. (setq *doc* (vla-get-ActiveDocument *acad*))
  1503. ;;带过滤器的entsel
  1504. (defun Fsxm-entsel (msg filter)
  1505.   (setq enp (entsel msg))
  1506.   (if (or (= (type enp) 'str)
  1507.           (and enp (ssget (cadr enp) filter))
  1508.       )
  1509.     enp
  1510.   )
  1511. )
  1512. ;


评分

参与人数 4D豆 +25 贡献 +4 收起 理由
xshrimp + 5 + 1 很给力!经验;技术要点;资料分享奖!
仲文玉 + 5 很给力!经验;技术要点;资料分享奖!
炫翔 + 5 + 1 很给力!经验;技术要点;资料分享奖!
XDSoft + 10 + 2 很给力!经验;技术要点;资料分享奖!

查看全部评分

本帖被以下淘专辑推荐:

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2013-8-5 00:05:18 | 显示全部楼层
真是叼啊!只看懂了一部分啊!

点评

慢慢的 你会看懂的  发表于 2013-8-5 14:49
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

点击这里给我发消息

已领礼包: 85个

财富等级: 招财进宝

发表于 2013-8-14 22:21:00 | 显示全部楼层
很有用的资料
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

点击这里给我发消息

发表于 2013-8-16 13:45:26 | 显示全部楼层
晕 要 授权码的啊????
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

点击这里给我发消息

已领礼包: 5701个

财富等级: 富甲天下

发表于 2013-10-29 14:33:12 | 显示全部楼层
授权码是什么啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-11-10 23:45:32 | 显示全部楼层
楼主这个是干什么用的啊?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 329个

财富等级: 日进斗金

发表于 2013-12-22 08:04:09 | 显示全部楼层
看一看,学习楼主编程
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2014-4-16 15:34:52 | 显示全部楼层
感谢分享,支持了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2014-6-17 16:14:06 | 显示全部楼层
授权码...自己加密?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

点击这里给我发消息

发表于 2014-7-4 23:03:35 | 显示全部楼层
好东东,新手路过学习...
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1325个

财富等级: 财源广进

发表于 2014-8-16 11:56:07 | 显示全部楼层
其中的炸散嵌套块程序好像对非等比加旋转嵌套块无效
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2014-9-2 19:19:22 | 显示全部楼层
正想学习程序加密
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2014-9-3 23:11:26 | 显示全部楼层
如何再有.dcl对话框源文件就更好了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 6464个

财富等级: 富甲天下

发表于 2014-10-15 21:53:47 | 显示全部楼层
非常好,感谢楼主分享。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 11个

财富等级: 恭喜发财

发表于 2014-10-21 00:23:26 | 显示全部楼层
收集不容易啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2020-6-3 07:06 , Processed in 0.285096 second(s), 97 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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