将块放置在u线的起点乐筑天下 - Powered by Discuz! Archiver

woodman78 发表于 2022-7-5 20:50:13

将块放置在u线的起点

大家好，

我已经修改了Dave Corrall的lisp，以根据我们的要求创建链测长度。我想知道如何在直线的垂直起点添加“Chainage\u Tick”。

有人能帮忙吗？

;draw chainages
;by Dave Corrall 12-Nov-2001

;degrees>radians
(defun dtr (a)
(* pi (/ a 180.0))
)
;radians>degrees
(defun rtd (a)
(* 180.0(/ a pi))
)

(defun intro ()
(setq dialog-state 999)
(setq dialog_pos (list -1 -1))
(setq dcl_id (load_dialog "intro.dcl"))
(princ "\nDialog Box:")
(while (< 2 dialog-state)
(new_dialog "intro" dcl_id "" dialog_pos)
(set_tile "lname" "Chainages on Polyline")
(setq x (dimx_tile "DC")
y (dimy_tile "DC"))
(fill_image 0 0 x y -15)
(start_image "DC")
(slide_image 0 0 x y "dc_logo")
(end_image)
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(quit_routine)")
(action_tile "about" "(setq userclick1 t)(open_about)")
(setq dialog-state (start_dialog))
(if (= dialog-state 1)
(princ)
;    (princ "\nDialog Box: ")
)
)
(unload_dialog dcl_id)
;(princ "\nDialog Box: ")
)

; tell about routine

(defun open_about ()
;(done_dialog)
(startapp "notepad.exe" "chains.txt")
;(setq userclick1 nil)
)

(defun quit_routine ()
(setq qr "Q")
)

(defun chainage ()
(setq oreq(getvar"attreq")odia(getvar"attdia"))
(setq oldlayer(getvar "clayer"))
(setvar "attreq" 1)
(setvar "attdia" 0)
(setvar "osmode" 1024)
(command "ucs" "")
(setq r 0.0)
(setq seg 0.0)
(if (= (tblsearch "LAYER" "CCC_LAYOUT_Chainages") nil)
(command "layer" "m" "CCC_LAYOUT_Chainages" "c" "7" "" "")
(command "layer" "s" "CCC_LAYOUT_Chainages" "")
)
(setq step(getreal "\nSet interval to display Chainage text: ")
svprefix "Ch"
svsuffix "m"
scale "1"
svval 0)
(setq nam (car (entsel "\nSelect Polyline: ")))
(command "_change" nam """p" "Layer" "CCC_LAYOUT_Chainages" "color" "Bylayer" "")
(setq ent (entget nam))
(command "_.insert" "Chainage_Tick" nil)
(command "measure" nam "b" "Chainage_Tick" "y" "10" "")
(if (not (equal (cdr (assoc 0 ent)) "LWPOLYLINE"))
(prompt "\nEntity not a polyline...")
(progn
(setq nv (cdr(assoc 90 ent)))
(setq ent1 (member(assoc 10 ent)ent))
(setq ent2(cdr ent1))
(setq ent2(member(assoc 10 ent2)ent2))
(while (/= ent2 nil)
(if (/= ent2 nil)

               (progn

;IF THE VERTEX PRECEDES A STRAIGHT LINE

                  (if (equal (cdr (assoc 42 ent1)) 0.0)
                  (progn
                     (setq v1(cdr(assoc 10 ent1))
      v2(cdr(assoc 10 ent2))
      a(angle v1 v2)
      d(distance v1 v2)
      p1(polar v1 a (- step r))
      d1(distance p1 v2)
      )
(if(< seg 1)
   (progn
(setq value(strcat svprefix (rtos svval 2 0) svsuffix ))
(command "-insert" "Chainage_Text" v1 scale scale (rtd a) value)
)
   )
(if(<(+ d r) step)
   (progn
   (setq r (+ d r))
   )
   (progn
   (setq num(1+(fix(/ d1 step))))
   (setq cnt 0)
   (repeat num
      (progn
(setq pt(polar p1 a (* cnt step)))
(setq svval(+ svval step)
      value(strcat svprefix (rtos svval 2 0) svsuffix ))
(command "-insert" "Chainage_Text" pt scale scale (rtd a) value)
(setq cnt (1+ cnt))
)
      )
   (setq r(rem d1 step))
   )
   )
; set new values for variables
(setq ent1 ent2)
(setq ent2(cdr ent2))
(setq ent2(member(assoc 10 ent2)ent2))
(setq seg(1+ seg))
);end progn for straight section
;if the vertex preceds an arc
(progn
   (setq v1(cdr(assoc 10 ent1))
v2(cdr(assoc 10 ent2))
bulge(cdr(assoc 42 ent1))
)
   (setq a(angle v1 v2)
d(distance v1 v2)
radi(abs(/ d(* 2.0(sin(*(atan bulge) 2)))))
)
   (setq hfd(/ d 2.0)
thet(atan(/(sqrt(-(* radi radi)(* hfd hfd)))hfd))
)
   (if (< (abs bulge) 1)       ; if > 180 deg
                           (if (< bulge 0)          ; if clockwise
                              (setq dtoc (- a thet))
                              (setq dtoc (+ a thet))
                           )
                           (if (< bulge 0)
                           (setq dtoc (+ a thet))
                           (setq dtoc (- a thet))
                           )
                     )
                        (setq p1 v1)
                        (setq p2 v2)
                        (setq pc (polar p1 dtoc radi))
                        (setq beg (angle pc p1))
                        (setq end (angle pc p2))
; CALCULATE LENGTH OF ARC

                        (setq swept (abs (- beg end) ))
                        (setq len (abs (* (- beg end) radi)))
                        (if (and (< (abs bulge) 1) (> swept pi ))
                           (setq len (- (* 2 pi radi) len))
                        )

                     (if (< (+ len r) step)
                     (progn
                        (setq r (+ len r))
                     )
                     (progn
                        (if (and (> (abs bulge) 1) (< swept pi ))
                           (setq len (- (* 2 pi radi) len))
                        )
                        (setq beta (- step r))
                        (setq len1 (- len beta))
                        (if (> bulge 0)
                           (setq beg (+ beg (/ beta radi) ) )
                           (setq beg (- beg (/ beta radi) ) )
                        )
                        (setq num (1+ (fix (/ len1 step))))
                        (setq astep (/ step radi ))
                        (setq cnt 0)
                        (repeat num
                           (progn
                              (if (> bulge 0)
                                 (setq ai (+ beg (* cnt astep))
   ab(+ ai (dtr 90)))
                                 (setq ai (- beg (* cnt astep))
   ab(- ai (dtr 90)))
                              )
                              (setq pt (polar pc ai radi))
(setq svval(+ svval step)
      value(strcat svprefix (rtos svval 2 0) svsuffix ))
(command "-insert" "Chainage_Text" pt scale scale (rtd ab) value)
(setq cnt (1+ cnt))
)
      )
   (setq r(rem len1 step))
   (if(equal r 0.0)(setq r step))
   )
   )
; set new values for variables
(setq ent1 ent2)
(setq ent2(cdr ent2))
(setq ent2(member(assoc 10 ent2)ent2))
);end progn for arc section
);end if check straight or arc
      );end progn
);end if /= ent2 nil
);end while /= ent2 nil
)
)
;reset variables
(setvar "attreq" oreq)
(setvar "attdia" odia)
(command "layer" "s" oldlayer "")
(command "ucs" "p")
)
(defun thanku()
(setq dialog-state 999)
(setq dialog_pos (list -1 -1))
(setq dcl_id (load_dialog "thanks.dcl"))
(while (< 2 dialog-state)
(new_dialog "thanks" dcl_id "" dialog_pos)
(set_tile "lname" "Chainage Routine")
(setq x (dimx_tile "DC")
y (dimy_tile "DC"))
(fill_image 0 0 x y -15)
(start_image "DC")
(slide_image 10 10 x y "dc_logo")
(end_image)
(setq dialog-state (start_dialog))
(if (= dialog-state 1)
(princ)
)
)
(unload_dialog dcl_id)
(princ)
)

;command routine
(defun c:chains ()
(intro)
(if(= qr "Q")
(progn
(setq qr nil)
(thanku)
)
(progn
(chainage)
(thanku)
)
)
)

;PI's on pipelines no radiused bends

(defun c:bends ()
(if (= (tblsearch "LAYER" "Bend_numbers") nil)
(command "layer" "m" "Bend_numbers" "c" "1" "" "")
(command "layer" "s" "Bend_numbers" "")
)
(setq bend 1.0)
(setq nam (car (entsel "\nSelect Polyline: ")))
(setq ent (entget nam))
(if (not (equal (cdr (assoc 0 ent)) "LWPOLYLINE"))
(prompt "\nEntity not a polyline...")
(progn
(setq nv (cdr(assoc 90 ent)))
(setq ent1 (member(assoc 10 ent)ent))
(setq ent2(cdr ent1))
(setq ent2(member(assoc 10 ent2)ent2))
(while (/= ent2 nil)
               (setq v1(cdr(assoc 10 ent1))
               v2(cdr(assoc 10 ent2))
         a(angle v1 v2)
   )
   (command "text" "c" (polar v1 (+ (dtr 90) a) (* scale 1.25)) (* scale 3.5) (rtd a) (rtos bend 2 0))
(setq bend(1+ bend))
(setq ent1 ent2)
(setq ent2(cdr ent2))
(setq ent2(member(assoc 10 ent2)ent2))
)
)
)
)

链测长度_文本。图纸
链测长度记号。图纸

BIGAL 发表于 2022-7-5 21:20:19

需要添加最后一个例程，该例程查看起始角度（如果直线+90），如果线段是圆弧，则查看endpt cenpt，然后再次执行end segment。你有；如果现在检查直线或圆弧，则结束。

woodman78 发表于 2022-7-5 22:19:26

谢谢你的帮助比格尔。我把它整理好了。

页: [1]

乐筑天下's Archiver

将块放置在u线的起点