detai2.lsp

plc设计编程软件

;dtl.lsp
;局部放大
;线、弧和圆修剪到框边界。 多义线和等比例块在修剪之前拆开一级。

(princ "\n初始装载 ... 稍候\n")

(defun val (x e) (cdr (assoc x e)))

(defun enttype (e) (cdr (assoc 0 e)))

(defun entname (e) (cdr (assoc -1 e)))
(setq >90 (/ pi 2) >270 (* 3 (/ pi 2)))

;在ss中找到线、弧和圆的“端点”，处于由对角点pll和pur组成的矩形外边，将它们提交给命令函数。

(defun osends (ss pll pur / z eps)
  (ends ss)     ;将“端点”放在表eps里
  (foreach z eps    ;检查它们是否在矩形外边
    (if (or (< (caadr z) (car pll))
        (< (cadadr z) (cadr pll))
        (> (caadr z) (car pur))
        (> (cadadr z) (cadr pur))
      )
      (command z)
    )
  )
)

;在ss中找到线、弧和圆的“端点”。
;“端点”是：
;   线：  端点
;   弧：  端点和象限点
;   圆；  象限点

(defun ends (ss / i ent cen)
  (setq len (sslength ss) i 0)  ;取实体数
  (while (< i len)        ;通过它们循环
    (setq ent (entget (ssname ss i))) ;取相关列表
    (cond       ;检查线、弧和圆并记录相应点到eps里。其它实体类型忽略。
          ;线
      ((= (enttype ent) "LINE")
        (setq eps (cons (list (entname ent) (val 10 ent)) eps))
        (setq eps (cons (list (entname ent) (val 11 ent)) eps)) )
          ;弧
      ((= (enttype ent) "ARC")
        (setq cen (val 10 ent))
        (setq eps (cons 
          (list (entname ent) 
            (polar cen 0 (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent)
            (polar cen >90 (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent) 
          (polar cen pi (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent) 
          (polar cen >270 (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent) 
            (polar cen (val 50 ent) (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent) 
            (polar cen (val 51 ent) (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent) 
          (osnap (polar cen (val 51 ent) (val 40 ent)) "mid")) eps)) )
        ;圆
      ((= (enttype ent) "CIRCLE")
        (setq cen (val 10 ent))
        (setq eps (cons 
          (list (entname ent) 
          (polar cen 0 (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent)
          (polar cen >90 (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent) 
          (polar cen pi (val 40 ent))) eps))
        (setq eps (cons 
          (list (entname ent) 
          (polar cen >270 (val 40 ent))) eps)) )
    )
    (setq i (1+ i))   ;下一实体
  )
)

;拆开所有多义线到选择集s里

(defun exp_pl (s / i len ent)
  (setq i 0 len (sslength s))
  (while (< i len)
    (setq ent (entget (ssname s i)))
    (cond
      ((= (enttype ent) "POLYLINE")
        (command "explode" (entname ent))
      )
      ((= (enttype ent) "INSERT")
        (if (= (val 41 ent) (val 42 ent) (val 43 ent))  ;检查等比例
          (command "explode" (entname ent))
        )
      )
    )
    (setq i (+ 1 i))
  )
)

;擦除部分拆开的目标区外的多义线

(defun era_xtra (e)
  (setq ssx (ssadd))
  (while (setq e (entnext e))
    (if (not (ssmemb e ss))
      (ssadd e ssx)
    )
  )
  (command "erase" ssx "") 
)

;取几何外形并调用程序裁剪。

(defun c:dtl (/ px py pxx pyy xs ss b ssx)
  (setvar "cmdecho" 0)
  (if (and
      ;定义局部放大的矩形
    (setq px (getpoint "\n第一个角： "))
    (setq py (getcorner px "\n另一个角： "))
      ;局部放大矩形的左下角
    (setq pxx (getpoint px "\n新的第一个角位置： "))
      ;局部放大比例因子
    (setq xs (getreal "\n细节比例因子： ")) )
    (progn
      ;复制选到的素材
  (command "copy" "c" px py "" px pxx)
  (command "pline" px (list (car px) (cadr py)) ;绘制基础面积的外形
      py (list (car py) (cadr px)) "c")         
          ;这些是可能需要裁剪的新的实体。
  (setq ss (ssget "c" pxx (polar pxx (angle px py) (distance px py))))
          ;首先拆开多义线，如果裁剪它们，有许多新的实体要处理。
  (setq last (entlast)) ;保存数据库尾端
  (exp_pl ss) ;拆开它们然后取所有新实体到ss里
  (setq ss (ssget "c" pxx (polar pxx (angle px py) (distance px py))))
    ;擦除完全在矩形外部的实体
  (era_xtra last)
  (command "scale" ss "" pxx xs)    ;放大局部
          ;局部放大的新对角点
  (setq pyy (polar pxx (angle px py) (* xs (distance px py))))
  (command "pline" pxx (list (car pxx) (cadr pyy))  ;局部放大框
      pyy (list (car pyy) (cadr pxx)) "c")          
  (command "trim" (setq b (entlast)) "")  ;最后的多义线被切去边
  (osends ss pxx pyy)   ;找到处于框外边的端点并裁去它们。
  (command "")    ;结束裁剪
  (redraw b)
    )
  )
  (setvar "cmdecho" 1)
  (princ)
)