Merge 2 lisp

[taybac213]

Lisp 1(Lisp offsec Lee Mac): create 2 secment offset  to the pline. Length secment =select 2 points on the pline
Lisp 2(Lisp note): Create a note by selecting 2 points
Please help to combine the 2 lisp above (Lisp 3): Lisp creates a notes secment by pick 2 points on the pline?

OffsetSectionV1-1.lsp Lisp note.lsp

[Steven P]

Rather than combine the 2 I would be tempted to make a 3rd LISP that runs them in order. My preference since you can still use the 2 individual LISPs independently.

 

So what to do:

At the end of Lee Macs LISP, at the end of the main function and before the closing bracket - perhaps replacing the (princ) add something like:

(list p q)

this will return a list from this LISP I think, Point P1 and Point P2

 

In the note LISP replace the first line:

 

c:2 ( p1 p2 / di nm a str hf p11)

 

which now requires you to supply the 2 points before the LISP will run, finally make up the LISP to run them together:

 

(defun c:test ( / alist e p1 p2)
  (setq alist (c:offsec))
  (c:2 (nth 0 alist) (nth 1 alist))
  (princ)
)

 

 

 

Very much untested at the weekend

Edited August 26, 2023 by Steven P

[taybac213]

Thanh you @Steven P!II will try it right away

[taybac213]

I don't want to bother you on the weekend!I'll ask you more next week!Thanks you!

[BIGAL]

Sometimes it can be as simple as chain the correct sequence of commands, did not look very hard at code.

Lots of code

(c:offsec)

(c:2)

 

Edited August 26, 2023 by BIGAL

[Steven P]

ahh., forgot, have to remove the get points part of the second lisp - will have a look next week, remind me

[Steven P]

A couple of changes to make from the codes:

This is Lee Macs with a return value at the end (the selected points) Refer to above or his website for the original version

 

;;------------------=={ Offset LWPolyline Section }==-------------------;;


(defun c:offsec ( / d e h l m n o p q w x z )
    (if (null *off*)
        (setq *off* 1.0)
    )
    (initget 6)
    (if (setq d (getdist (strcat "\nSpecify Offset <" (rtos *off*) ">: ")));Chọn khoảng cách ofsset
        (setq *off* d)
        (setq d *off*)
    )
    (while
        (progn (setvar 'errno 0) (setq e (car (entsel "\nSelect LWPolyline: ")));Chọn polyline
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null e) nil)
                (   (/= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
                    (princ "\nObject is not an LWPolyline.")
                )
                (   (setq p (getpoint "\nSpecify 1st Point: "))
                    (setq p (vlax-curve-getclosestpointto e (trans p 1 0)))
                    (while
                        (and
                            (setq  q (getpoint (trans p 0 1) "\nSpecify 2nd Point: "))
                            (equal p (setq q (vlax-curve-getclosestpointto e (trans q 1 0))) 1e-8)
                        )
                        (princ "\nPoints must be distinct.")
                    )
                    (if q
                        (progn
                            (if (> (setq m (vlax-curve-getparamatpoint e p))
                                   (setq n (vlax-curve-getparamatpoint e q))
                                )
                                (mapcar 'set '(m n p q) (list n m q p))
                            )
                            (setq e (entget e)
                                  h (reverse (member (assoc 39 e) (reverse e)))
                                  h (subst (cons 70 (logand (cdr (assoc 70 h)) (~ 1))) (assoc 70 h) h)
                                  l (LM:LWVertices e)
                                  z (assoc 210 e)
                            )
                            (repeat (fix m)
                                (setq l (cdr l))
                            )
                            (if (not (equal m (fix m) 1e-8))
                                (setq x (car l)
                                      w (cdr (assoc 40 x))
                                      l
                                    (cons
                                        (list
                                            (cons  10 (trans p 0 (cdr z)))
                                            (cons  40 (+ w (* (- m (fix m)) (- (cdr (assoc 41 x)) w))))
                                            (assoc 41 x)
                                            (cons  42
                                                (tan
                                                    (*  (- (min n (1+ (fix m))) m)
                                                        (atan (cdr (assoc 42 x)))
                                                    )
                                                )
                                            )
                                        )
                                        (cdr l)
                                    )
                                )
                            )
                            (setq l (reverse l))
                            (repeat (+ (length l) (fix m) (- (fix n)) -1)
                                (setq l (cdr l))
                            )
                            (if (not (equal n (fix n) 1e-8))
                                (setq x (car l)
                                      w (cdr (assoc 40 x))
                                      l
                                    (vl-list*
                                        (list
                                            (cons 10 (trans q 0 (cdr z)))
                                           '(40 . 0.0)
                                           '(41 . 0.0)
                                           '(42 . 0.0)
                                        )
                                        (list
                                            (assoc 10 x)
                                            (assoc 40 x)
                                            (cons  41
                                                (+ w
                                                    (*  (/ (- n (max m (fix n))) (- (1+ (fix n)) (max m (fix n))))
                                                        (- (cdr (assoc 41 x)) w)
                                                    )
                                                )
                                            )
                                            (cons  42
                                                (tan
                                                    (*  (if (< (fix n) m) 1.0 (- n (fix n)))
                                                        (atan (cdr (assoc 42 x)))
                                                    )
                                                )
                                            )
                                        )
                                        (cdr l)
                                    )
                                )
                            )
                            (setq o
                                (vlax-ename->vla-object
                                    (entmakex (append h (apply 'append (reverse l)) (list z)))
                                )
                            )
                            (vl-catch-all-apply 'vla-offset (list o d))
                            (vl-catch-all-apply 'vla-offset (list o (- d)))
                            (vla-delete o)
                        )
                    )
                )
            )
        )
    )
    (princ)


(list p q) ;;Addd this


)

;; Tangent  -  Lee Mac
;; Args: x - real
 
(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-8))
        (/ (sin x) (cos x))
    )
)
 
;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes the position,
;; starting width, ending width and bulge of a vertex of an LWPolyline
 
(defun LM:LWVertices ( e )
    (if (setq e (member (assoc 10 e) e))
        (cons
            (list
                (assoc 10 e)
                (assoc 40 e)
                (assoc 41 e)
                (assoc 42 e)
            )
            (LM:LWVertices (cdr e))
        )
    )
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
    (strcat
        "\n:: OffsetSection.lsp | Version 1.1 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"offsec\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

 

This is the notes LISP to accept 2 points as inputs, again refer to the above for the original

 

;https://www.theswamp.org/index.php?topic=54646.0
;;(DEFUN c:2 (/ p1 p2 di nm a str hf p11)

(DEFUN c:2 (p1 p2 / di nm a str hf p11) ;; changed this

  (IF (OR (NOT g:tarrow:hf) (NOT (NUMBERP g:tarrow:hf)) (NOT (> g:tarrow:hf 0.0)))
    (SETQ g:tarrow:hf 100.0)
  ) ; end if
  (INITGET 6)
  (SETQ hf (GETREAL (STRCAT "\n->Enter text height < " (RTOS g:tarrow:hf 2 2) " > : "))) ; FONT HEIGHT = altura da fonte
  (IF (> hf 0.0)
    (SETQ g:tarrow:hf hf)
  ) ; end if

  (setq txtstyle (getvar 'textstyle))
  
;;  (WHILE (SETQ p1 (GETPOINT "\n-> Click the first point :")) ; FIRST POINT = Give a first point
;;    (IF (SETQ p2 (GETPOINT p1 "\r-> Click the next point :     ")) ; SECOND POINT = Now give me a second point
;;      (PROGN ; split this away from the setq line
  (SETQ di  (/ (* g:tarrow:hf 0.45) 0.5) 
            nm  (TRANS '(0.0 0.0 1.0) 1 0 T)
            a   (ANGLE p1 p2)
            str ""                  			   
            p11 (POLAR (POLAR p1 (ANGLE p1 p2) (/ (DISTANCE p1 p2) 2.0)) (- a (* PI 0.5)) (/ g:tarrow:hf 5.0))			  ) ; end setq
  (ENTMAKE (LIST
      (CONS 0 "LWPOLYLINE")
      (CONS 100 "AcDbEntity")
      (CONS 100 "AcDbPolyline")
      (CONS 90 3)
      (CONS 70 0)
      (CONS 8 "Texto e Seta") ; Text and arrow
      (CONS 10 (TRANS p2 1 nm))
      (CONS 40 0.0)
      (CONS 41 (/ di 2.0))
      (CONS 62 21)
      (CONS 10 (TRANS (POLAR p2 (ANGLE p2 p1) di) 1 nm))
      (CONS 10 (TRANS p1 1 nm))
      (CONS 210 nm)
    ) ; end list
  ) ; end entmake

  (WHILE (AND (NOT (> (STRLEN str) 0)) (NOT (WCMATCH str "*#*@*")) (NOT (WCMATCH str "*@*#*")))		 
    (setq default (vlax-ldata-get "DC-MWA" "str" "TNT-UPVC-D200"))
    (if (= "" (setq str (getstring T (strcat "\nEnter text note <" default ">: "))))
      (setq str default)
      (vlax-ldata-put "DC-MWA" "str" str))
    ) ; emd if
    (ENTMAKE (LIST
        (CONS 0 "TEXT")
        (CONS 100 "AcDbEntity")
        (CONS 100 "AcDbText")
        (CONS 7 txtstyle)				
        (CONS 10 (LIST 2. 2. 2.))
        (CONS 40 g:tarrow:hf)
        (CONS 41 0.6)							
        (CONS 8 "Texto e Seta") ; Text and arrow
        (CONS 62 1)
        (CONS 1 str)
        (CONS 50
          (IF (MINUSP (COS a))
            (+ PI a)
            a
          )
        )
        (CONS 72 1)
        (CONS 11 (MAPCAR '(LAMBDA (X1 X2) (/ (+ X1 X2) 2.)) P1 P2))
        (CONS 73 1)
      ) ; end list
    ) ; end entmake
;;      ) ; end progn
;;    ) ; end if
;;  ) ; end while
  (PRINC)	
 
)
 ;|«Visual LISP© Format Options»
(140 2 40 2 nil "end of " 100 9 2 1 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;

 

[taybac213]

Thank you
I have tried, can you help me fix it as shown below

[Steven P]

Should be easy enough... is there a set offset for the text and arrow or will it depend on the offset from Lee Macs code?

[taybac213]

thanks you very much @Steven !