[LISP程序]：lsp程序程序

crtrccrt

;17.插座穿墙
;main function
(defun c:czcq (/       p1      p2      p3      p4      s       e
               e1      n       l       pp      aaa     tscale  iscale
               ndwg_nm tkname  syname  dwg_nm  _dzinter               _dzotlt
               _wlayer _wcolor bj      c_cqx   tmpl    int     i
               pmsblay p       a3      a2      i       a       cq_se
               cq_se2  dwgmode tkname  DIS     ENL     a1      bk_inf
               tmpl    el en kname     bk_txt
              )
  (setq olderr *error*)
;-----------------*error*-----------------------------------------------

  (defun *error* (msg / eachxx)
    (if (/= msg "quit / exit abort")(progn
    (_Hidesb)
    (spara 0 2 "" -1 -1 1 0 -1)
    (command "_.undo" "_end")
    (setq *error* olderr
          olderr  nil
    )
    (foreach eachxx '(p1      p2      p3      p4      s              e
                      e1      n              l              pp      aaa     tscale
                      iscale  ndwg_nm tkname  syname  dwg_nm  _dzinter
                      _dzotlt _wlayer _wcolor bj      c_cqx   tmpl
                      int     i              pmsblay p              a3      a2
                      i              a              cq_se   cq_se2  dwgmode tkname
                      DIS     ENL     a1      nn      bk_inf  tmpl ndwg_nm
                      dis1 dis2 el en kname   bk_txt
                     )
      (set eachxx nil)
    )
    (setq eachxx nil)
    (_resdwg)
    )
    (setq *error* olderr
          olderr  nil
    )
    )
    (princ)
  )
;----------------------------------------------------------------------------

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;变角函数------调用来自于
  ;;aa : 任意角度值(弧度)
  ;;返回(0 -- 2 * pi)间角度(弧度)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun bj (aa / nn)
    (if        (equal aa (* 2 pi) 0.01)
      (setq aa 0.0)
    )
    (setq nn (and (>= aa 0) (< aa (* pi 2.0))))
    (while (not nn)
      (cond ((< aa 0) (setq aa (+ aa (* pi 2.0))))
            ((>= aa (* pi 2.0)) (setq aa (- aa (* pi 2.0))))
      )
      (setq nn (and (>= aa 0) (< aa (* pi 2.0))))
    )
    (if        (equal aa (* 2 pi) 0.01)
      (setq aa 0.0)
    )
    aa
  )

;;--------------------------------------------
;;得到块的信息函数
;;输入:要插入的块的全路径
;;返回:(块定义的Y向距离 插入点到块的底边距离)
(defun bk_inf(dwg_nm / p1 p2 p ndwg_nm tmpl dis1 dis2)
  (setq p1 (XScjx) p2 (cadr p1) p1 (car p1))
  (command "_.insert" dwg_nm (polar p1 (angle p2 p1) (distance p2 p1)) 1 1 0)
  (entdel (entlast))
  (setq ndwg_nm (GetBN dwg_nm))
  (setq tmpl (XBlkLn ndwg_nm 1))
  (setq p (nth 0 tmpl) p1 (nth 1 tmpl) p2 (nth 2 tmpl))
  (setq dis1 (- (cadr p)(cadr p1)))
  (setq dis2 (read (xgetin "dwglib" "Dwgscale" "1.0" 1)))
  (list (abs ( - (cadr p2) (cadr p1))) (* dis1 dis2 tscale))
)
;;--------------------------------------------
;;修改块内文字的角度函数
;;输入:块名(若有文字则将其处理成-90-+90之间的角度)
;;返回:无
(defun bk_txt (en1 / a1 a2 a3 el en kname)
  (setq el (entget en1))
  (setq a1 (cdr(assoc 50 el)))
  (setq kname (cdr(assoc 2 el)))
  (setq en (cdr (assoc -2 (tblsearch "block" kname))))
  (setq a2 nil)
  (if (= (cdr (assoc 0 (entget en))) "TEXT")
    (setq a2 (cdr (assoc 50 (entget en))))
    (progn
      (while (and (entnext en) (null a2))
        (setq en (cdr (assoc -1 (entget (entnext en)))))
        (if (= (cdr (assoc 0 (entget en))) "TEXT")
          (setq a2 (cdr (assoc 50 (entget en))))
        )
      )
    )
  )
  (if a2
    (progn
      (setq a3 (bj (+ a2 a1)))
      (if (and (> a3 (* 0.5 pi)) (< a3 (* 1.5 pi)))
        (progn
          (setq a3 (bj (+ a3 pi)))
          (setq a3 (/ (* 180.0 a3) pi))
          (setq a3 (- a3 (/ (* 180.0 a1) pi)))
          (if(< a3 0)(setq a3 (+ 360 a3)))
          (_chgbtAng 1 "新块名" (cdr(assoc 8 (entget en1))) en1 a3);修改目标
        )
      )
    )
  )
)
  
;main
  (if (= (ISFUNRUN) nil)(exit))
  (princ "\n*插座穿墙布置*=Czcq")
  (_inidwg)
  (setvar "cmdecho" 0)
  (command "_.undo" "_begin")
  (setvar "osmode" 0)
  (setq        _wLayer        "WALL"
        _wColor        "BYLAYER"
  )
  (setq _DZINTER (atof (xgetps "Pmdata\\Sbcs\\Dzinter" "0.0")))
  (setq _DZOTLT (atoi (xgetps "Pmdata\\Sbcs\\Dzotlt" "1")))

  (setq pmsblay (xgetin "Dwglib" "Dwglayer" "BPM"))
  (command "_Layer" "m" pmsblay "c" 4 "" "")
  (setq tscale (atof (xrddic "Tabscale" "100")))

  (if (or (= (IfWndVis "fhklibclass") 0)
          (/= (strcase (last (gpara))) "CZCQ")
      )
    (progn
      (fhklib 0 2 "" -1 -1 1 0 7)        ;消息串必须为空,否则菜单不刷新
    )
  )

                                        ;先读dwg_nm,syname是为了显示设备参数窗口,
                                        ;后面还要读,因为用户中途可能会改变设备
  (setq dwg_nm (xgetin "dwglib" "dwgname" "" 1))
  (setq syname (xgetin "dwglib" "syname" "辅助设备" 1))
  (setq tkname (xgetin "dwglib" "tkname" "辅助设备" 1))
  (setq dwgmode (xgetin "dwglib" "Dwgmode" "0" 1))
  (if (= dwgmode "0")
    (_showsb syname tkname (getbn dwg_nm))
    (_showsb syname tkname (strcat (getbn dwg_nm) "_" dwgmode))
  )


  (setq aaa 1)
  (while aaa
       ;;;此处是为(ins_s_pc ...)准备,为了在输入第一点时有设备拖动效果
    (setq dwg_nm (xgetin "dwglib" "dwgname" "" 1))
    (spara 0 1 "r" -1 -1 0 0 -1)

    (setq p1 (ins_s_pc dwg_nm "\n状态:" "请输入第一点" 0))
    (setvar "osmode" 0)
    (if        p1
      (progn
        ;;;此处是为了在任何提示下均能改变设备,但不发消息,以不影响任何提示
        (spara 1 -1 "" -1 -1 -1 -1 -1)
        (setq p2 (getpoint p1 "\n请输入第二点:"))
        (setvar "osmode" 0)
        (while (not p2)
          (setq p2 (getpoint p1 "\n请输入第二点:"))
        )
        (setvar "osmode" 0)
        (setq s         (ssget        "f"
                        (list p1 p2)
                        (list (cons 0 "LINE,ARC,CIRCLE") (cons 8 _wLayer))
                 )
              pp nil
        )
        (setq dwg_nm (xgetin "dwglib" "dwgname" "" 1))
        (setq tmpl1 (bk_inf dwg_nm))
        (setq syname (xgetin "dwglib" "syname" "辅助设备" 1))
        (while (and s (setq e (ssname s 0)))
          (cond
            ((= (cdr (assoc 0 (entget e))) "LINE")
             (setq p (inters p1
                             p2
                             (cdr (assoc 10 (entget e)))
                             (cdr (assoc 11 (entget e)))
                     )
             )
             (if p
               (progn
                 (if (= (length p) 2)
                   (setq p (append p '(0.0)))
                 )
                 (setq tmpl (xfxfx e p 300 -20))
               )
               (setq tmpl nil)
             )
             (if tmpl
               (progn
                 (setq a1  (car tmpl)
                       dis (cadr tmpl)
                       e1 (caddr tmpl)
                       pp (polar p (- a1 pi) dis)
                 )
                 (setq a (angle pp p))
                 (setq a (- a (* 0.5 pi)))
                 (if (and (= _DZOTLT 0) (= syname "插座"))
                   (progn
                     (setq ndwg_nm (strcat (GetBN dwg_nm) "$"))
                     (cczbk dwg_nm ndwg_nm 0 (car tmpl1) 180)
                     (Ins_block        ndwg_nm
                                (polar p (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                                (* 180.0 (/ a pi))
                     )
                     (bk_txt (entlast))
                   )
                   (progn
                     (Ins_block dwg_nm
                       (polar p (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                       (* 180.0 (/ a pi))
                     )
                     (bk_txt (entlast))
                   )
                 )
                 (setq a (angle p pp))
                 (setq a (- a (* 0.5 pi)))
                 (if (and (= _DZOTLT 0) (= syname "插座"))
                   (progn
                     (setq ndwg_nm (strcat (GetBN dwg_nm) "$"))
                     (cczbk dwg_nm ndwg_nm 0 (car tmpl1) 180)
                     (Ins_block        ndwg_nm
                                (polar pp (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                                (* 180.0 (/ a pi))
                     )
                     (bk_txt (entlast))
                   )
                   (progn
                     (Ins_block dwg_nm
                       (polar pp (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                       (* 180.0 (/ a pi))
                     )
                     (bk_txt (entlast))
                   )
                 )
                 (ssdel e1 s)
               )
             )
             (ssdel e s)
            )
            ((= (cdr (assoc 0 (entget e))) "ARC")
             (setq int (get_ipt_ln_arc
                         p1
                         p2
                         (cdr (assoc 10 (entget e)))
                         (cdr (assoc 40 (entget e)))
                         (cdr (assoc 50 (entget e)))
                         (cdr (assoc 51 (entget e)))
                         3
                       )
             )
             
             (if int
               (progn
                 (setq i 0)
                 (repeat (length int)
                   (setq p (nth i int))
                   (if (= (length p) 2)
                     (setq p (append p '(0.0)))
                   )
                   (setq tmpl (xfxfx e p 300 -20))
                          (if tmpl
                     (progn
                       (setq a1         (car tmpl)
                             dis (cadr tmpl)
                             e1         (caddr tmpl)
                             pp (polar p (- a1 pi) dis)
                       )
                       (setq a (angle pp p))
                       (setq a (- a (* 0.5 pi)))
                       (if (and (= _DZOTLT 0) (= syname "插座"))
                         (progn
                           (setq ndwg_nm (strcat (GetBN dwg_nm) "$"))
                           (cczbk dwg_nm ndwg_nm 0 (car tmpl1) 180)
                           (Ins_block ndwg_nm
                                      (polar p (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                                      (* 180.0 (/ a pi))
                           )
                           (bk_txt (entlast))
                         )
                         (progn
                           (Ins_block dwg_nm
                             (polar p (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                             (* 180.0 (/ a pi))
                           )
                           (bk_txt (entlast))
                         )
                       )
                       (setq a (angle p pp))
                       (setq a (- a (* 0.5 pi)))
                       (if (and (= _DZOTLT 0) (= syname "插座"))
                         (progn
                           (setq ndwg_nm (strcat (GetBN dwg_nm) "$"))
                           (cczbk dwg_nm ndwg_nm 0 (car tmpl1) 180)
                           (Ins_block ndwg_nm
                                      (polar pp (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                                      (* 180.0 (/ a pi))
                           )
                           (bk_txt (entlast))
                         )
                         (progn
                           (Ins_block dwg_nm
                             (polar pp (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                             (* 180.0 (/ a pi))
                           )
                           (bk_txt (entlast))
                         )
                       )
                       (ssdel e1 s)
                     )
                   )
                   (setq i (1+ i))
                 )
               )
             )
             (ssdel e s)
            )
            ((= (cdr (assoc 0 (entget e))) "CIRCLE")
             (setq int (get_ipt_ln_arc
                         p1
                         p2
                         (cdr (assoc 10 (entget e)))
                         (cdr (assoc 40 (entget e)))
                         0.0
                         pi
                         0
                       )
             )
             (if int
               (progn
                 (setq i 0)
                 (repeat (length int)
                   (setq p (nth i int))
                   (if (equal (+ (distance2p p p1) (distance2p p p2))
                              (distance2p p1 p2)
                              0.01
                       )
                     
                     (progn
                       (if (= (length p) 2)
                         (setq p (append p '(0.0)))
                       )
                       (setq tmpl (xfxfx e p 300 -20))
                     )
                     (setq tmpl nil)
                   )
                   (if tmpl
                     (progn
                       (setq a1         (car tmpl)
                             dis (cadr tmpl)
                             e1         (caddr tmpl)
                             pp (polar p (- a1 pi) dis)
                       )
                       (setq a (angle pp p))
                       (setq a (- a (* 0.5 pi)))
                       (if (and (= _DZOTLT 0) (= syname "插座"))
                         (progn
                           (setq ndwg_nm (strcat (GetBN dwg_nm) "$"))
                           (cczbk dwg_nm ndwg_nm 0 (car tmpl1) 180)
                           (Ins_block ndwg_nm
                                      (polar p (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                                      (* 180.0 (/ a pi))
                           )
                           (bk_txt (entlast))
                         )
                         (progn
                           (Ins_block dwg_nm
                             (polar p (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                             (* 180.0 (/ a pi))
                           )
                           (bk_txt (entlast))
                         )
                       )
                       (setq a (angle p pp))
                       (setq a (- a (* 0.5 pi)))
                       (if (and (= _DZOTLT 0) (= syname "插座"))
                         (progn
                           (setq ndwg_nm (strcat (GetBN dwg_nm) "$"))
                           (cczbk dwg_nm ndwg_nm 0 (car tmpl1) 180)
                           (Ins_block ndwg_nm
                                      (polar pp (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                                      (* 180.0 (/ a pi))
                           )
                           (bk_txt (entlast))
                         )
                         (progn
                           (Ins_block dwg_nm
                             (polar pp (+ (* 0.5 pi) a) (+ _DZINTER (cadr tmpl1)))
                             (* 180.0 (/ a pi))
                           )
                           (bk_txt (entlast))
                         )
                       )
                       (ssdel e1 s)
                     )
                   )
                   (setq i (1+ i))
                 )
               )
             )
             (ssdel e s)
            )
          )
        )
      )
      (setq aaa nil)
    )
  )                                        ; while aaa
  (_Hidesb)
  (spara 0 2 "" -1 -1 1 0 -1)
  (command "_.undo" "_end")
  (setq        *error*        olderr
        olderr        nil
  )
  (_resdwg)
  (princ)
)


(Setfunhelp "C:Czcq" "Idq30.hlp" "ID_CZCQ")