明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2315|回复: 6

自己编的绘制焊缝程序,lisp源码与大家分享,多指教

[复制链接]
发表于 2012-11-22 22:18:30 | 显示全部楼层 |阅读模式
(defun c:hf  (/ en endata  ps pe ll ang r n lc ce osm oldlay ref ce pp)
  (princ "绘制焊缝")
  (setq r (getreal "\n 输入焊缝高度<6>"))
  (if (null r)
    (setq r 6.0))
  (command "pline")
  (command (setq enpt (getpoint "\n 输入点:")))
  (while enpt
    (setq enpt (getpoint enpt "\n 输入点:"))
    (if        (atom enpt)
      (command "")
      (command enpt)
      )
    )
  (setq        enline     (entlast)
        endata (entget (entlast)))
  (defun dohf  (ps pe)
    (setq
      ll  (distance ps pe)
      ang (angle ps pe))                                                  
    (setq n (fix (/ (- ll r r) r)))
    (setq lc (/ (- ll r r) n))
    (setq ce (polar ps ang r))
    (setq osm (getvar "osmode"))
    (setq oldlay (getvar "clayer"))
                                                  ;(setq oldsnap (getvar "")
    (setvar "osmode" 0)
    (setvar "cmdecho" 0)
    (if        (null (tblsearch "layer" "填充层"))
      (command "layer" "n" "填充层" "c" "8" "填充层" ""))
    (setvar "clayer" "填充层")
    (command "arc" ps "c" ce "a" -180)
    (setq ref (entlast))
    (setq ce (polar ce ang lc))
    (setq pp (polar ce ang r))
    (command "arc" pp "c" ce "a" 180)
    (command "trim"
             ref
             ""
             (list (entlast) (polar ce (+ pi ang) r))
             "")
    (setq plc (entlast))
    (setvar "SNAPANG" ang)
    (command "array" plc "" "r" 1 n lc)
    (setvar "SNAPANG" 0)
    (defun get_ss  (ref_en / en ss)                  ;自动取得选取集
      (setq ss (ssadd))
      (while (setq en (entnext ref_en))
        (setq ss     (ssadd en ss)
              ref_en en)
        )
      ss
      )
    (command "-group" "c" "*" "" ref (get_ss ref) "")
    (command "chprop" (entlast) "" "c" 8 "la" "填充层" "")
    (setvar "osmode" osm)
    (setvar "clayer" oldlay)
    (prin1)
    )
  (while (assoc 10 endata)
                                                  ;(setq 10lst (cons (cdr (assoc 10 endata)) 10lst))
    (setq ps (cdr (assoc 10 endata)))
    (setq endata (cdr (member (assoc 10 endata) endata)))
    (setq pe (cdr (assoc 10 endata)))
    (if        (not (null pe))
      (dohf ps pe))
    )
  (command "erase" enline "")
  (prin1)
  )
(prompt
  "\n<<C:HF>>焊缝"
  )
(prin1)

发表于 2012-11-22 22:49:26 | 显示全部楼层
不错!学习下

发表于 2012-11-23 12:18:29 | 显示全部楼层
焊缝标注是很复杂的,你这个是不是太简单了?
发表于 2012-11-23 12:45:13 | 显示全部楼层
忘记在国外哪个论坛上看到过关于焊缝的, 好像加密了
不过解密也容易, 好像很长
发表于 2012-11-23 16:10:44 | 显示全部楼层
不符合规范要求,用动态块吧,这样更简单
发表于 2013-6-21 21:50:07 | 显示全部楼层
适合装修用,非常感谢!
发表于 2013-7-9 21:53:00 | 显示全部楼层
绘图会方便很多
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-5-26 13:14 , Processed in 0.169111 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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