Hi all. Please help me write lisp
I have a red line and a green line.
I want the green line Moved to the red line, With the green end of the line just attached to the red line
thanks
Move line
I have modified my code as follows:
(defun C:MvLines (/ lst-RoadLine ena-GreenLine go-on1 lst0-ena
lst1-ena jud-proper ena-LeftSlope ena-RoadTop ena-RightSlope
pt01 pt02 pt03 pt04 pt05 pt06
width-road dist0-hor vect01 vect02 sin01 sin02
dist1-hor vect03 sin03 jud-proper1 pt-int01 pt-a
cons01 pt-int02 cons02 pt-from pt-from)
(setq m:err *error*
*error* *merrmsg*)
(Set-Cmdecho&Osnapcoord)
(princ (strcat "\n Function : Move a green line and related culvert lines to proper"
" position between two red lines of road side slopes.\n"))
(syms->T 'go-on0)
(while go-on0
(and
;;01
(progn
(syms->nil '(lst-RoadLine ena-GreenLine lst-CulvertLine))
(syms->T 'go-on1)
(while go-on1
(and
;;A01
(setq lst0-ena (SsGet1
(list (strcat "Select the related lines（including 1 green"
" and 3 red）: ")
"（Quantity of Selected lines）"
'((0 . "line"))
'(SymS->Nil '(go-on1 go-on0)))))
;;A02
(progn
(setq jud-proper (>= (length lst0-ena) 4))
(if (not jud-proper)
(princ-alert
"Quantity of Selected lines should not be less than 4!"))
jud-proper)
;;A03
(progn
(setq lst1-ena (all-if '(lambda (ena0)
(= 3 (CL-ena ena0)))
lst0-ena)
jud-proper (= 1 (length lst1-ena)))
(if (not jud-proper)
(princ-alert "There should be 1（and only 1）GREEN line!"))
jud-proper)
;;A04
(and
;;B01
(progn
(setq ena-GreenLine (car lst1-ena)
lst1-ena (all-if '(lambda (ena0)
(= 1 (CL-ena ena0)))
lst0-ena)
jud-proper (= 3 (length lst1-ena)))
(if (not jud-proper)
(princ-alert "There should be 3（and only 3）RED lines!"))
jud-proper)
;;B02
(progn
(setq jud-proper (P-Enas-3DLinkedLine lst1-ena))
(if (not jud-proper)
(princ-alert "The 3 red lines should be linked!"))
jud-proper))
;;A05
(progn
(setq lst-RoadLine lst1-ena
lst-CulvertLine (remove-items
(cons ena-GreenLine lst-RoadLine)
lst0-ena))
(syms->nil 'go-on1)))
(if lst0-ena
(UnHlight lst0-ena)))
(and ena-GreenLine lst-RoadLine))
;;02
(progn
(syms->nil 'jud-proper1)
(setq lst-RoadLine
(vl-sort lst-RoadLine
'(lambda (ena1 ena2 /)
(< (car (apply 'Vector+ (EndPoints0-Ena ena1)))
(car (apply 'Vector+ (EndPoints0-Ena ena2)))))))
(mset '(ena-LeftSlope ena-RoadTop ena-RightSlope) lst-RoadLine)
(mset '(pt01 pt02) (EndPoints-Ena ena-LeftSlope))
(mset '(pt03 pt04) (EndPoints-Ena ena-RightSlope))
(mset '(pt05 pt06) (EndPoints-Ena ena-GreenLine))
(cond
((progn
(setq width-road (distance pt02 pt03)
dist0-hor (- (car pt03) (car pt02)))
(not (equal width-road dist0-hor 0.001)))
(princ-alert "The road top line should be level!"))
((progn
(setq vect01 (VectorExpr->Vector (list pt01 pt02))
vect02 (VectorExpr->Vector (list pt03 pt04)))
(mset '(sin01 sin02)
(mapcar 'Sin-2dVector (list vect01 vect02)))
(or (<= sin01 0)
(>= sin02 0)
(and (equal 1 sin01 0.001)
(equal -1 sin02 0.001))))
(princ-alert
"The gradients of two side slopes should be proper!"))
((progn
(setq dist1-hor (- (car pt06) (car pt05)))
(<= dist1-hor dist0-hor))
(princ-alert
(strcat "The horizontal length of the green line should exceed"
" that of the top red line!")))
((progn
(setq vect03 (VectorExpr->Vector (list pt05 pt06))
sin03 (Sin-2dVector vect03))
(< (abs sin03) 1e-4))
(princ-alert "The culvert line should not be level!"))
(T
(syms->T 'jud-proper1)))
jud-proper1)
;;03
(setq pt-int01 (if (< sin03 0)
(Inters1 (list pt03 pt04)
(list (setq pt-a (vector+ pt02 vect03))
(vector- pt-a vect01))
nil)
(Inters1 (list pt01 pt02)
(list (setq pt-a (vector- pt03 vect03))
(vector+ pt-a vect02))
nil)))
;;04
(progn
(if (< (car pt-int01) (car pt03))
(setq cons01 (list ena-LeftSlope pt-int01 pt02)
pt-int02 (vector+ pt-int01 vect03)
cons02 (list ena-RightSlope pt03 pt-int02)
pt-from pt05)
(setq cons01 (list ena-RightSlope pt03 pt-int01)
pt-int02 (vector- pt-int01 vect03)
cons02 (list ena-LeftSlope pt-int02 pt02)
pt-from pt06))
(cmd-move (cons ena-GreenLine lst-CulvertLine)
(list pt-from pt-int01))
(foreach cons0 (list cons01 cons02)
(apply 'Put-EndPoints cons0))
(princ "\n Done."))))
(setq *error* m:err
m:err nil)
(princ))
@chan230984 已写:Hi friend
When I
Command: MVLINES
no function definition: SET-CMDECHO&OSNAPCOORD
Command:
Yes, it's normal. Because a lot of self-defined functions including Set-Cmdecho&Osnapcoord have been called directly and indirectly in the command function C:MvLines. I need to spend some time, perhaps one day , to pick out all the related self-defined functions and send them to you. And only after loading all the related self-defined functions, the command function C:MvLines can work.
The reason to develope so many commonly used self-defined functions is to simplify coding. I think it's the typical way for LISP coding.
@sby0531 please give us your rosetta stone
https://blog.britishmuseum.org/everything-you-ever-wanted-to-know-about-the-rosetta-stone/
So we can decipher you hieroglyph
