Jump to content

Help with slope lisp

Guest

By Guest
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Guest

Guest

Posted
Posted

Hi, Happy New year.

 

I have a slope lisp. Work by picking two points and insert  slope text . I change the code to pick a line and insert the slope.

I want to add

  

(initget "Line Points")

 

To work for points and Line. It is all the stuff in the code, but I stuck. Can anyone help

  

(defun c:SlopePC (/ p1 p2 a scl ht)
  (command "_layer" "_m" "Slope" "_c" "140" "" "")
  (command "style" "TopoCAD" "arial.ttf" 0 "" "" "" "" "")
  (setq scl (getvar "useri1")) ; <--- Please dont change
  (setq ht (* 0.00175 scl)) ; <--- Please dont change
  (setvar "OSMODE" 521)

 ; (initget "Line Points")
  ;(if (eq (setq	TL-sel
;		 (getkword (strcat "\nSelect Line or Points[Line/Points]: " "< Line >"))
;	  )
;	  "Points"
;      )
 ; (if
  ;  (and
   ;   (setq p1 (getpoint "\n1st Point: "))
   ;   (setq p2 (getpoint "\n2nd Point: "))
   ;   (setq a (angle p1 p2))
   ; )
      (setq TL-Line (ssget '((0 . "LINE"))))
      (setq e (ssname TL-Line 0))
      (setq p1 (cdr (assoc 10 (entget e))))
      (setq p2 (cdr (assoc 11 (entget e))))
      (setq a (angle p1 p2))
     (entmake
       (list
	 '(0 . "TEXT")
	 '(7 . "TopoCAD")
	 '(100 . "AcDbEntity")
	 '(100 . "AcDbText")
	 '(10 0. 0. 0.)
	 (cons 40 ht)
	 (cons 1
	       (strcat (rtos (abs (* 100 (/ (sin a) (cos a)))) 2 2) " %")
	 )
	 (cons 50
	       (if (minusp (cos a))
		 (+ pi a)
		 a
	       )
	 )
	 '(72 . 1)
	 (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2))
	 '(73 . 1)
       )
     )
 ; ); end if
  (princ)
)

 

Steven P Grand Master

Steven P

Posted
Posted

So a quick look, if I take out all the ';', think the error comes to the if statements....

 

One of them doesn't have a closing ')' - unless I can't count (this is possible) - might be good to label all the closing ')' with what function they are ending, 'if' 'and' 'eq' or whatever

 

As it is the second 'if' statement has 6 statements after, where there should only be 2. Might be you need to enclose some of these with a '(progn' and closing ')'

 

 

Maybe this is more like it?

  

(defun c:SlopePC (/ p1 p2 a scl ht)
  (command "_layer" "_m" "Slope" "_c" "140" "" "")
  (command "style" "TopoCAD" "arial.ttf" 0 "" "" "" "" "")
  (setq scl (getvar "useri1")) ; <--- Please dont change
  (setq ht (* 0.00175 scl)) ; <--- Please dont change
  (setvar "OSMODE" 521)

  (initget "Line Points")
  (if (eq 
      (setq TL-sel (getkword (strcat "\nSelect Line or Points[Line/Points]: " "< Line >")))
      "Points"
    ) ; end eq
    (if  
      (and
        (setq p1 (getpoint "\n1st Point: "))
        (setq p2 (getpoint "\n2nd Point: "))
        (setq a (angle p1 p2)) ;; can delete this line or move after the 'if'

;;;ADDED THIS
      ) ; end and

      ) ; end if

;;;ADDED THIS
      (progn
        (princ "Select Line")

        (setq TL-Line (ssget '((0 . "LINE"))))
        (setq e (ssname TL-Line 0))
        (setq p1 (cdr (assoc 10 (entget e))))
        (setq p2 (cdr (assoc 11 (entget e))))

;;;ADDED THIS
     ) ; end progn


        (setq a (angle p1 p2)) ; as above, can move this line or move after 'if'

;;;ADDED THIS
   ) ; end if


        (entmake
          (list
            '(0 . "TEXT")
            '(7 . "TopoCAD")
            '(100 . "AcDbEntity")
            '(100 . "AcDbText")
            '(10 0. 0. 0.)
             (cons 40 ht)
            (cons 1
  	       (strcat (rtos (abs (* 100 (/ (sin a) (cos a)))) 2 2) " %")
            ) ; end cons
            (cons 50
  	       (if (minusp (cos a))
  		 (+ pi a)
  		 a
  	       ) ; end if
            )
            '(72 . 1)
            (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2))
            '(73 . 1)
          ) ; end list
        ) ; end entmake

;;  ) ; end if ;;DELETE THIS?
  (princ)
)

 

Steven P Grand Master

Steven P

Posted
Posted (edited)

Then as a suggestion, 

  

        (setq TL-Line (ssget '((0 . "LINE"))))
        (setq e (ssname TL-Line 0))

 

works but might be better as  

(setq e (car(entsel "Select Line")))

 

or use 

  

(setq TL-Line (ssget "_+.:E:S" '((0 . "LINE"))))
(setq e (ssname TL-Line 0))

 

to allow single object selection ( http://lee-mac.com/ssget.html )

 

.. and then (setq e (entget (.... shortens the code a bit later

 

Might then be:

  

(defun c:SlopePC (/ p1 p2 a scl ht)
  (command "_layer" "_m" "Slope" "_c" "140" "" "")
  (command "style" "TopoCAD" "arial.ttf" 0 "" "" "" "" "")
  (setq scl (getvar "useri1")) ; <--- Please dont change
  (setq ht (* 0.00175 scl)) ; <--- Please dont change
  (setq os_old (getvar "OSMODE"))
  (setvar "OSMODE" 521)

  (initget "Line Points")
  (if (eq 
      (setq TL-sel (getkword (strcat "\nSelect Line or Points[Line/Points]: " "< Line >")))
      "Points"
    ) ; end eq
    (if  
      (and
        (setq p1 (getpoint "\n1st Point: "))
        (setq p2 (getpoint "\n2nd Point: "))
      ) ; end and
      (setq a (angle p1 p2))
    ) ; end if
    (progn
      (princ "Select Line")
      (setq TL-Line (ssget "_+.:E:S" '((0 . "LINE"))))
      (setq e (entget (ssname TL-Line 0))) ; can combine this line with the one above if you want
      (setq p1 (cdr (assoc 10 e)))
      (setq p2 (cdr (assoc 11 e)))
      (setq a (angle p1 p2))
    ) ; end progn
  ) ; end if
  (setvar "OSMODE" os_old)

  (entmake
    (list
      '(0 . "TEXT")
      '(7 . "TopoCAD")
      '(100 . "AcDbEntity")
      '(100 . "AcDbText")
      '(10 0. 0. 0.)
      (cons 40 ht)
      (cons 1
        (strcat (rtos (abs (* 100 (/ (sin a) (cos a)))) 2 2) " %")
      ) ; end cons
      (cons 50
      (if (minusp (cos a))
          (+ pi a)
          a
      ) ; end if
      )
      '(72 . 1)
      (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2))
      '(73 . 1)
    ) ; end list
  ) ; end entmake
  (princ)
)

 

 

also worth putting in an (setq osmode_old (getvar "OSMODE")) before you change it and then you can reset it to what it was when you have finished selecting lines or points

Edited by Steven P
devitg Experienced

devitg

Posted
Posted
44 minutes ago, prodromosm said:

Hi Steven P.I have this message

  

; error: syntax error

 

As to test , please upload your sample dwg. or state the

(getvar "useri1") 

(getvar "useri1")

 

Guest

Guest

Posted
Posted 
( DEFUN C:SETSC ()
  (setvar "OSMODE" 13)
    (SETQ CURSC (getvar "useri1" ))
    (princ "Set scale 1:")(princ cursc)
    (setq newsc (getint "\nNew scale 1:"))
    (setvar "useri1" newsc)
      (setq a1 (getvar "useri1"))
    (princ "\n The scale is 1:")(princ newsc)(princ)
)

 

Steven P Grand Master

Steven P

Posted
Posted
1 hour ago, prodromosm said:

Hi Steven P.I have this message

  

; error: syntax error

 

 

 

It should be corrected now

devitg Experienced

devitg

Posted
Posted
16 minutes ago, Steven P said:

 

 

It should be corrected now

@Steven P, please show the correction done to your lisp.

Guest

Guest

Posted
Posted 
(defun c:SlopePC (/ p1 p2 a scl ht)
  (command "_layer" "_m" "Slope" "_c" "140" "" "")
  (command "style" "TopoCAD" "arial.ttf" 0 "" "" "" "" "")
  (setq scl (getvar "useri1")) ; <--- Please dont change
  (setq ht (* 0.00175 scl)) ; <--- Please dont change
  (setq os_old (getvar "OSMODE"))
  (setvar "OSMODE" 521)

  (initget "Line Points")
  (if (eq 
      (setq TL-sel (getkword (strcat "\nSelect Line or Points[Line/Points]: " "< Line >")))
      "Points"
    ) ; end eq
    (if  
      (and
        (setq p1 (getpoint "\n1st Point: "))
        (setq p2 (getpoint "\n2nd Point: "))
      ) ; end and
      (setq a (angle p1 p2))
    ) ; end if
    (progn
      (princ "Select Line")
      (setq TL-Line (ssget "_+.:E:S" '((0 . "LINE"))))
      (setq e (entget (ssname TL-Line 0))) ; can combine this line with the one above if you want
      (setq p1 (cdr (assoc 10 e)))
      (setq p2 (cdr (assoc 11 e)))
      (setq a (angle p1 p2))
    ) ; end progn
  ) ; end if
  (setvar "OSMODE" os_old)

  (entmake
    (list
      '(0 . "TEXT")
      '(7 . "TopoCAD")
      '(100 . "AcDbEntity")
      '(100 . "AcDbText")
      '(10 0. 0. 0.)
      (cons 40 ht)
      (cons 1
        (strcat (rtos (abs (* 100 (/ (sin a) (cos a)))) 2 2) " %")
      ) ; end cons
      (cons 50
      (if (minusp (cos a))
          (+ pi a)
          a
      ) ; end if
      )
      '(72 . 1)
      (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2))
      '(73 . 1)
    ) ; end list
  ) ; end entmake
  (princ)
)

 

Steven P Grand Master

Steven P

Posted
Posted
54 minutes ago, devitg said:

@Steven P, please show the correction done to your lisp.

 

 

It was the second (setq a (angle p1 p2)) in the wrong place,

 

Corrected to be:

  

    (progn
      (princ "Select Line")
      (setq TL-Line (ssget "_+.:E:S" '((0 . "LINE"))))
      (setq e (entget (ssname TL-Line 0))) ; can combine this line with the one above if you want
      (setq p1 (cdr (assoc 10 e)))
      (setq p2 (cdr (assoc 11 e)))
      (setq a (angle p1 p2))
    ) ; end progn

 

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

(setq scl (getvar "useri1")) ; <--- Please dont change

Rather than above use 

(if (= (vlax-ldata-get "Prodromosm" "scl") nil)
(progn 
(setq scl (getreal "\nEnter scale "))
(vlax-ldata-put "Prodromosm" "scl" scl)
)
)

User1 can be changed by other programs.

Edited by BIGAL

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...