两马赫 发表于 2012-11-22 22:18:30

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

(defun c:hf(/ en endataps 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)

ZHENYOUDNG 发表于 2012-11-22 22:49:26

不错!学习下

自贡黄明儒 发表于 2012-11-23 12:18:29

焊缝标注是很复杂的,你这个是不是太简单了?

sunny20102 发表于 2012-11-23 12:45:13

忘记在国外哪个论坛上看到过关于焊缝的, 好像加密了
不过解密也容易, 好像很长

myjping 发表于 2012-11-23 16:10:44

不符合规范要求,用动态块吧,这样更简单

szxgsh 发表于 2013-6-21 21:50:07

适合装修用,非常感谢!

jyzas 发表于 2013-7-9 21:53:00

绘图会方便很多
页: [1]
查看完整版本: 自己编的绘制焊缝程序,lisp源码与大家分享,多指教