[求助]关于打剖面线的问题

随身听

我写了个把手的画图程序,但是当d=10时剖面线总出错,d为其它值时则正常,请问是怎么回事?

HQ_2003

随身听

d=10的时候,剖面线会占满整个图形,当d 取其他值的时候你对比一下就能看出来,我想不明白到底是什么问题.

龙龙仔

1.用pline重画剖面线边线,再选物件建剖面线

2.多画一条直线,程序如下;


(defun C:XXBS ()
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq DCL_ID (load_dialog "xxbsdlg.dcl"))
  (new_dialog "xxbsdlg" DCL_ID)
  (start_image "xxbs")
  (slide_image 0 0 (dimx_tile "xxbs")(dimy_tile "xxbs") "xxbs")
  (end_image)
  (setq        C1   NIL
        D    NIL
        D1   NIL
        WHAT NIL
  )
  (action_tile "alf" "(setq c1 $value)")
  (action_tile
    "d6"
    "(setq d 32 d1 6 d2 14 d3 14 d4 2 h 18 h1 5 h2 8 r 16)"
  )
  (action_tile
    "d8"
    "(setq d 40 d1 8 d2 18 d3 16 d4 2 h 22 h1 6 h2 10 r 20)"
  )
  (action_tile
    "d10"
    "(setq d 50 d1 10 d2 22 d3 25 d4 3 h 26 h1 7 h2 12 r 25)"
  )
  (action_tile
    "d12"
    "(setq d 65 d1 12 d2 24 d3 32 d4 3 h 35 h1 9 h2 16 r 32)"
  )
  (action_tile
    "d16"
    "(setq d 80 d1 16 d2 30 d3 40 d4 4 h 45 h1 11 h2 20 r 40)"
  )
  (action_tile "accept" "(done_dialog 2)")
  (action_tile "cancel" "(done_dialog 0)")
  (setq WHAT (start_dialog))
  (if (= WHAT 2)
    (progn (if (not C1)
             (progn (alert "未输入旋转角")
                    (exit)
             )
           )                                ;end if1
           (setq ALF (atof C1))
           (setq P0 (getpoint "\n插入点:")
           )
           (setq TAN10 0.176327)
           (setq SIN54 0.809017)
           (setq X (* (* D 0.5) SIN54))
           (setq P1  (polar P0 (* 0.5 pi) (* 0.5 D3))
                 P3  (list (- (car P1) (* TAN10 (* 0.5 (- D D3))))
                           (+ (cadr P1) (* 0.5 (- D D3)))
                     )
                 P4  (list (- (car P0) H2) (cadr P3))
                 P5  (polar P4 (* 1.5 pi) (- (* 0.5 (- D D2)) 3))
                 P6  (polar P5 (* 1.25 pi) (* 3 1.414))
                 P7  (list (- (car P0) H) (cadr P6))
                 P8  (polar P7 (* 1.5 pi) (* 0.5 (- D2 D1)))
                 P9  (polar P8 (* 1.5 pi) 0.5)
                 P10 (polar P9 (* 1.5 pi) (- D1 1))
                 P11 (polar P8 (* 1.5 pi) D1)
                 P12 (polar P7 (* 1.5 pi) D2)
                 P13 (polar P6 (* 1.5 pi) D2)
                 P14 (polar P5 (* 1.5 pi) (+ D2 6))
                 P15 (polar P4 (* 1.5 pi) D)
                 P16 (polar P3 (* 1.5 pi) D)
                 P18 (polar P1 (* 1.5 pi) D3) ;外轮廓点
                 P19 (polar P18 pi (* 0.5 H2))
                 P20 (polar P1 pi (* 0.5 H2))
                 P23 (polar P8 0 (- H (* 0.5 H2)))
                 P24 (polar P9 0 (- H (* 0.5 H2)))
                 P22 (polar P10 0 (- H (* 0.5 H2)))
                 P21 (polar P11 0 (- H (* 0.5 H2))) ;螺纹点
                 P2  (list (- (car P1) (* TAN10 (- X (* 0.5 D3))))
                           (+ (cadr P1) (- X (* 0.5 D3)))
                     )
                 P17 (list (car P4) (cadr P2))
           )
           (command "ltscale" 30)
           (command "layer"  "n"      "中心线" "n"        "剖面线"
                    "n"             "细线"   "n"      "虚线"        "n"
                    "标注线" "n"      "双点化线"        "c"
                    "1"             "中心线" "c"      "2"        "剖面线"
                    "c"             "3"      "细线"   "c"        "4"
                    "虚线"   "c"      "4"      "标注线"        "c"
                    "6"             "双点化线"               "l"        "center"
                    "中心线" "l"      "hidden" "虚线"        "l"
                    "divide" "双点化线"               "lw"        0.15
                    "细线"   "lw"     0.15     "标注线"        "lw"
                    0.15     "剖面线" ""
                   )
           (command "line" P15 P16 P18 P1 P3 P4 P5 ""
                    "arc" P6 "c" (list (car P6) (cadr P5)) P5                       
                    "line" P6 P7 P12 ""
                    "pline" P15 P14 "a" "ce" (list (car P13) (cadr P14)) P13 "l" P12 ""
           )
           (command "line" P1          P20         P19        P18    ""     "line"
                    P9           P24          ""         "line"        P10    P22    ""
                   )
           (command "layer" "s" "细线" "")
           (command "line" P8 P23 "" "line" P11        P21 "")
           (command "layer" "s" "0" "")
           (command "pline" P17 P2 "")
           (command "circle"
                    (list (+ (car P9) H1) (cadr P0))
                    (* 0.5 D4)
           )
           (command "layer" "s" "剖面线" "")
           (setvar "hpname" "ansi31")
           (setvar "hpang" 0)
           (vl-cmdf ".bhatch" (list (+ (car P4) 2) (cadr P20)) "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;多画一条线来解决这问题
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           (command ".line" P14 P19 "")
           (setq QQ (entlast))
           (vl-cmdf ".bhatch"
                    (list (- (car P19) 1) (+ (cadr P19) 1))
                    (list (car P19) (- (cadr P19) 1))
                    ""
           )
           (command "erase" QQ "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           (command "layer" "s" "0" "")
           (command "rotate" "w"
                    (list (car P7) (cadr P4))
                    (list (car P18) (cadr P16))
                    ""  P0 ALF
           )                               
    )                                        ;end progn
  )                                        ;end if
  (if (= WHAT 0)
    (progn (alert "用户取消操作")
           (exit)
    )                                        ;end progn
  )                                        ;end if
  (princ)
)                                        ;end

随身听