[抛砖引玉]：结构精品程序源码下载

hnfsf

帮无极顶一下

animal212

很多人对你的visualisp网络连接很感兴趣，能不能再发一次啊。还有你天发的autoCAD-QQ进展怎么样了？期待中。还有现在XP系统局域网内传送消息已经不再支持了。能否用lisp再开发一个？

wujimmy

最初由 animal212 发布
[B]很多人对你的visualisp网络连接很感兴趣，能不能再发一次啊。还有你天发的autoCAD-QQ进展怎么样了？期待中。还有现在XP系统局域网内传送消息已经不再支持了。能否用lisp再开发一个？ [/B]

你可以用MINIQQ进行聊天.
现在QQ的协议那么复杂,做出来你都当老板了.

zhuiling

;;*********************************转载请注明****************************
;;原文地址:http://www.jgcad.com/article.asp?id=268
;;程序功能:插入PKPM所有计算结果到当前图纸,要求先进行图纸转换成DWG文件.
;;作者:吴所不及.
;;版权所有[结构CAD]http://www.jgcad.com
;;本站致力于结构画图软件开发,极力于提高结构师的画图效率.
;;如果你有什么好的建议,请告诉我们.
;;*********************************转载请注明****************************

(VL-LOAD-COM)

(setq paper-dist 2000);_图纸之间距离.
(defun c:jss()
(init_bonus_error
(list
(list "cmdecho" 0 "osmode" 0
)
T ;flag. True means use undo for error clean up.
);list
)

(alert "\n该函数用于生成所有的计算书.")

;;; (initget "Y N_Yes No")
;;; (setq changepos (getkword "\n是否插入到同一点?[Y/N]<Y>:"))
;;; (if (null changepos) (setq changepos "Yes"))

(setq dir-mid (qf_getFolder (strcat"选择文件夹<" (if filedir filedir "")">:")))
(if dir-mid (setq filedir dir-mid))

(command "layer" "m" "plot" "")
(setq pt-start (getpoint))

;;荷载. "第_1层梁、墙柱节点输入及楼面荷载平面图.DWG"

(setq file-list (vl-directory-files filedir "第??层梁、墙柱节点输入及楼面荷载平面图.DWG"))
(if file-list (setq max-distx (my_insert pt-start file-list 1)))
(setq pt-start (polar pt-start 0 max-distx))

;;板筋;bjss板计算结果01.DWG
(setq file-list (vl-directory-files filedir "*板计算结果*.dwg"))
(if file-list (setq max-distx (my_insert pt-start file-list 100)))
(setq pt-start (polar pt-start 0 (+ paper-dist max-distx)))

;;梁筋;
(setq file-list (vl-directory-files filedir "wpj*.dwg"))
(if file-list (setq max-distx (my_insert pt-start file-list 1000)))
(setq pt-start (polar pt-start 0 (+ paper-dist max-distx)))

;;梁截面;

(setq file-list (vl-directory-files filedir "FLR*.dwg"))
(if file-list (setq max-distx (my_insert pt-start file-list 1000)))
(setq pt-start (polar pt-start 0 (+ paper-dist max-distx)))

)

;;;(str-to-num "第11层梁、墙柱节点输入及楼面荷载平面图.DWG")

(defun str-to-num (str1)

(setq n 0)
(setq s1 "")
(while
(if  (and (/= "" (setq cha (substr str1 (setq n (1+ n)) 1))))

(if (wcmatch cha "#")
  (setq s1 (strcat s1 cha))
  (if (/= s1 "")
   nil
   t
  )
)
nil
)
)
(setq num1 (atoi s1))

)
(defun my_insert (pt file-list scale)
(setq diet 0)
(setq x (car pt)
  y (cadr pt))
(setq max-distx 0)

(setq
  file-list (vl-sort
     file-list
     (function
     (lambda (str1 str2)     
      (< (str-to-num str1 )
     (str-to-num str2 ))
       )
     
     );_lambda
     );_function
     )

(foreach filename file-list
(progn

  (command
   "_insert"
   (strcat filedir "\\" filename)
   (list x y 0)
   scale
   scale
   0
  )
  (progn
  (setq newen1 (entlast))
  (setq obj (vlax-ename->vla-object newen1))
(vla-getboundingbox obj 'll 'ur)
(setq pt1 (vlax-safearray->list ll))
(setq pt2 (vlax-safearray->list ur))
  
  (vl-cmdf ".rectangle" (polar pt1 -3.14 1000) pt2)
  (setq newen2 (entlast))
  (setq obj (vlax-ename->vla-object newen2))
  (vla-put-color obj acBlue)
  
  (entmake (list
   (cons 0 "TEXT")
   (cons 1 filename)
   (cons 40 350.0)
   (cons 41 0.7)
   (cons 10 (polar pt1 (* 0.5 pi) 1000))
   (cons 50 (/ pi 2))
   (cons 8 "filename")
   (cons 7 "STANDARD")   
   ))
  (setq newen3 (entlast))

  (command "_.move" newen1 newen2 newen3 "" pt1 (list x y 0))
  
  (setq distx (- (car pt2) (car pt1)))
  (setq disty (- (cadr pt2) (cadr pt1)))

  (setq max-distx (max distx max-distx))  
  (setq y (+ disty y paper-dist));_增加图的y坐标.
  

  ;(command "scale" newen "" (midpt pt1 pt2) 1.02);_外框放大.
  )
  (princ (strcat "\n" filedir filename))  
)
)
max-distx
)

我加载运行JSS 程序无反映，为何？

cces

赞wujimmy，提供了很好的学习程序，要多向wujimmy学习，发表原创程序，后面好好研究

bikeboy

确实是精品

xuewu

楼主真是高手，佩服，谢谢了

leochen

我也上传一个自己做的梁配筋面积转换到钢筋的小程序，内附说明

cyt1

好多好用的,但我是做建筑的

bikeboy

好东西不少  就是用不上啊

szlmh

向wujimmy学习；把源码都贴出来了

qiuxiang129

谢谢分享

albbzdc156

看到眼都花了  好好学习下

bloodmao

无极兄的东西一定要顶哦，呵呵

xiaoxu12345

好