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

两马赫

(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)

ZHENYOUDNG

不错！学习下

自贡黄明儒

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

sunny20102

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

myjping

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

szxgsh

适合装修用，非常感谢!

jyzas

绘图会方便很多