自己编的绘制焊缝程序,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)
不错!学习下
焊缝标注是很复杂的,你这个是不是太简单了? 忘记在国外哪个论坛上看到过关于焊缝的, 好像加密了
不过解密也容易, 好像很长 不符合规范要求,用动态块吧,这样更简单 适合装修用,非常感谢! 绘图会方便很多
页:
[1]