- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello I need help to modify this list so that the chaining is oriented with the polyline. I would also like to be able to add a prefix like CH: in front here are 2 images to illustrate the current problem of this lisp
the problem : https://imgur.com/PN5tZ0q
the result i am looking for : https://imgur.com/zU2n23p
;;DESIGNED BY ALEEM AHMAD KHAN
;;EPHED NESPAK, JUNE 24 2003
;;EDITED BY MIL, 20/05/2004
;
(DEFUN C:RDS()
(RDInput1)
(RDSA)
)
(defun C:RDS1()
(RDSA)
)
(defun RDSA ()
(setq cmdold (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq osmold (getvar "osmode"))
(setvar "osmode" 0)
(princ) (terpri)
(setq sst nil)
(while (= sst nil)
(setq sst (entsel "\nSelect Polyline/ Line for Marking RDs"))
)
(setq RD (+ RD rdi)) ; First Value
(COMMAND "MEASURE" sst "B" rdmB "" mdi)
(COMMAND "MEASURE" sst "B" "RD" "" rdii)
(setq SSET (ssget "P"))
(setq COUNT 0)
(while (< COUNT (sslength SSET))
(setq A1 (ssname SSET count))
(setq A2 (entget A1))
(setq A3 (cdr (assoc 0 A2)))
(if (= A3 "INSERT")
(progn
(setq A4 (assoc 10 A2))
(setq A5 (cdr A4))
(command "EXPLODE" a1)
(SETQ X1 (ENTGET(ENTLAST)))
(SETQ X2 (ASSOC 1 X1))
(SETQ X3 (CDR X2))
(SETQ RD5 (RTOS RD 2 0))
;(setq B1 (strcat "(" X3 ")"))
;(setq B1 (strcat RD5 "+000"))
(setq RDtxt RD5)
(text1)
(setq B1 RDtext)
(setq B2 (cons 1 B1))
;(setq A2 (subst B2 A4 A2))
(setq A2 (subst B2 X2 X1))
;(command "DDEDIT" "L" "")
(entmod A2)
(SETQ RD5 (ATOF RD5))
(SETQ RD (+ RD5 rdi))
);Progn
);if
(setq count (+ 1 count))
);while
(setvar "cmdecho" cmdold)
(setvar "osmode" osmold)
(terpri)
(princ (strcat " RD = " (rtos rd 2 0))) (terpri)
);defun
(defun text1 (/ abs2 rem1)
(if (and (= (strlen RDtxt) 1) (= RDtxt "0")) (Progn
(setq RDtxt "0000"))
(progn
(if (and (> (strlen RDtxt) 1) (<= (strlen RDtxt) 3))
(setq RDtxt (strcat "0" RDtxt)))
))
(setq abs2 (substr RDtxt 1 (- (strlen RDtxt) 3)))
(setq rem1 (substr RDtxt (+ (strlen abs2) 1)))
(setq RDtext (strcat abs2 "+" rem1))
)
(defun c:RDInput ()
(RDInput1)
)
(defun c:RD ()
(RD1)
)
(defun c:RDI()
(RDI1)
)
(defun c:RDM()
(RDM1)
)
(defun c:RDMB()
(RDMB1)
)
(defun c:SF()
(SF1)
)
(defun RDInput1 ()
(SF1) ; Scale Factor
(RD1) ; RD # and block
(RDblk)
(RDI1) ; RD interval
(RDM1) ; RD marker Interval
(RDMB1) ; RD marker block name
)
(defun RD1 (/ RD1)
(if (= RD nil) (setq RD 0))
(setq RD1 (getreal (strcat "\nStart RD # [" (rtos RD 2 0) "] :")))
(if (/= RD1 nil) (setq RD RD1))
(princ (strcat "RD = " (rtos rd 2 0))) (terpri)
)
(defun RDI1(/ rdiA)
(if (= rdi nil) (setq rdi 250))
(setq rdiA (getreal (strcat "\nRD # Interval [" (rtos RDi 2 0) "] :")))
(if (/= rdiA nil) (setq rdi rdiA))
(princ (strcat "RD Intr = " (rtos rdi 2 0))) (terpri)
(setq rdii (* rdi ssf))
)
(defun RDM1(/ mdA)
(if (= md nil) (setq md 250))
(setq mdA (getreal (strcat "\nRD Marker Distance [" (rtos md 2 0) "] :" )))
(if (/= mdA nil) (setq md mdA))
(if (> md rdi) (setq md rdi))
(princ (strcat "RD marker Dist = " (rtos md 2 0))) (terpri)
(setq mdi (* md ssf))
)
(defun RDMB1()
(if (= rdmB nil) (setq rdmB " "))
(setq rdmB (getstring (strcat "\nBranch/ Distributary Name for RD Marking [" rdmB "]:")))
(while (equal rdmB "")
(setq rdmB (getstring (strcat "\nBranch/ Distributary Name for RD Marking [" rdmB "]:"))))
(princ (strcat "RD marker Blk = " rdmB))
(RDmarker) ; RD marker Block
)
(defun SF1(/ ssf1)
(if (= ssf nil) (setq ssf 1.0))
(setq ssf1 (getreal (strcat "\nSheet Scale Factor [" (rtos ssf 2 😎 "] :")))
(if (/= ssf1 nil) (setq ssf ssf1))
(princ (strcat "Sheet Scale Factor = " (rtos ssf 2 8))) (terpri)
)
(defun RDblk(/ sl curlyr osmold list1)
(setvar "cmdecho" 0)
(setq osmold (getvar "osmode"))
(setvar "osmode" 0)
;(setq curLyr (getvar "clayer"))
;(command "layer" "thaw" "0" "set" "0" "on" "0" "")
(if (equal (tblsearch "block" "RD") nil) (progn
(command "zoom" "e")
(command "style" "ghc" "Arial" "0.0" "1.0" "0" "N" "N")
(command "color" "green")
(command "TEXT" "S" "ghc" "J" "ML" "0,0" "10.0" "90" "0+000")
;(setq list1 (list (cons 0 "TEXT") (cons 40 10.0) (cons 1 "0+000")))
(setq list1 (list (cons 0 "TEXT")(cons 1 "0+000")))
(setq sl (ssget "l" list1))
(command "block" "RD" "0,-10" sl "")
; (command "erase" sl "")
))
(setvar "osmode" osmold)
;(command "layer" "set" curlyr "on" curlyr "")
(command "zoom" "p")
)
(defun RDmarker(/ sl1 osmold list1)
(setvar "cmdecho" 0)
(setq osmold (getvar "osmode"))
(setvar "osmode" 0)
;(setq curLyr (getvar "clayer"))
(if (equal (tblsearch "block" rdmB) nil) (progn
(command "zoom" "e")
(command "color" "bylayer")
(command "line" "0,0" "0,5" "")
(setq list1 (list (cons 0 "LINE") (cons 10 (list 0.0 0.0 0.0)) (cons 11 (list 0.0 5.0 0.0))))
(setq sl1 (ssget "l" list1))
(command "block" rdmB "0,0" sl1 "")
; (command "erase" sl "")
))
(setvar "osmode" osmold)
;(command "layer" "set" curlyr "on" curlyr "")
(command "zoom" "p")
)
(princ "\nStart Command with:- <RDS> ")
(princ)
Chainage Mark on Pline.LSP
Affichage de Chainage Mark on Pline.LSP en cours.
Solved! Go to Solution.