UCS setting

May 19, 2020

In UCS “w” it's working perfectly. But if I will put any UCS I can't work properly. Not coming properly

How to solve this issue

(defun c:DRL (/ decs ;|diff|; elist level osm p1 p2 slope strlevel txtelev txthgt txtpt)
 (setq osm (getvar 'osmode))
 (while (and
   (or (not
  (setq txtelev (entsel "\nSelect starting level text : ")))
       (not
  (eq "TEXT"
      (cdr (assoc 0 (setq elist (entget (car txtelev)))))))))
   (princ
     "\n Nothing selected or wrong object type selected, try again")
   )
 (setq strlevel (cdr (assoc 1 elist))
 
level1  (atof strlevel)
txthgt  (cdr (assoc 40 elist))
)
  (setq level (* level1 1000))

 (initget 6)
 (setq slope (getreal "\n Enter slope in decimals <0.01> : "))
 (if (not slope)
   (setq slope 0.01))
 (setvar 'osmode 695)
 (setq p1 (getpoint "\nPick first point:"))
    (setq p1 (list (car p1)(cadr p1)))
;;;  (setq diff (mapcar '- (cdr (assoc 10 elist)) p1))

 (while (setq p2 (getpoint "\nPick next point (or press Enter to Exit): "))
   (setq p2 (list (car p2)(cadr p2)))
   (setq level    (- level (* (distance p1 p2) slope))
	 strlevel (rtos level 2 0)
	 txtpt   (getpoint "\nPick a text point: "); (mapcar '+ p2 diff)
	 )
   (setq strlevelwp(strcat "IL " (rtos (/ level 1000) 2 3)"M"))
   (entmake
     (list
'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 txtpt)
(cons 11 (list 0.0 0.0 0.0))
(cons 40 txthgt)
(cons 1 strlevelwp)
'(50 . 0.0)
'(41 . 1.0)
'(51 . 0.0)
'(7 . "Standard")
'(71 . 0)
'(72 . 0)
(cons 210 (list 0.0 0.0 1.0))
'(73 . 0))
     )
   (setq p1 p2)
   )

 (setvar 'osmode osm)
 (princ)
 )

May 19, 2020

@Ajmal please upload your sample.dwg where yo apply such lisp

Regards

May 19, 2020

Read about the (trans) function. You are also including lots of items with their default value (codes 41 50 51 71 72 210 & 73) so you don't need to include them unless they won't be the default value.

May 19, 2020

As dlanorh correctly suggests, trans is the key function here - perhaps consider something along the lines of the following:

(defun c:drl ( / *error* ang dis ent enx ins lvl ocs osm pt1 pt2 slp )

    (defun *error* ( msg )
        (if (= 'int (type osm)) (setvar 'osmode osm))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
   
    (setq osm (getvar 'osmode)
          ocs (trans '(0.0 0.0 1.0) 1 0 t)
          ang (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
          dis (lambda ( a b ) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
    )
    
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect starting level text: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (/= "TEXT" (cdr (assoc 0 (setq enx (entget ent)))))
                    (princ "\nThe selected object is not text.")
                )
                (   (not (setq lvl (distof (cdr (assoc 1 enx)) 2)))
                    (princ "\nThe selected text does not have numerical content.")
                )
                (   (progn
                        (initget 6)
                        (setq slp (cond ((getreal "\nSpecify slope in decimal <0.01>: ")) (0.01))
                              lvl (* 1000.0 lvl)
                        )
                        (setvar 'osmode 695)
                        (setq pt1 (getpoint "\nSpecify first point: "))
                    )
                    (while
                        (and
                            (setq pt2 (getpoint "\nSpecify next point <exit>: " pt1))
                            (setq ins (getpoint "\nSpecify text insertion <exit>: "))
                        )
                        (setq lvl (- lvl (* (dis pt1 pt2) slp)))
                        (entmake
                            (list
                               '(000 . "TEXT")
                                (cons 010 (trans ins 1 ocs))
                                (cons 001 (strcat "IL " (rtos (/ lvl 1000.0) 2 3) "M"))
                                (assoc 40 enx)
                                (cons 050 ang)
                                (cons 210 ocs)
                            )
                        )
                        (setq pt1 pt2)
                    )
                    nil
                )
            )
        )
    )
    (setvar 'osmode osm)
    (princ)
)

Edited May 19, 2020 by Lee Mac

May 20, 2020

12 hours ago, Lee Mac said:

As dlanorh correctly suggests, trans is the key function here - perhaps consider something along the lines of the following:


(defun c:drl ( / *error* ang dis ent enx ins lvl ocs osm pt1 pt2 slp )

    (defun *error* ( msg )
        (if (= 'int (type osm)) (setvar 'osmode osm))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
   
    (setq osm (getvar 'osmode)
          ocs (trans '(0.0 0.0 1.0) 1 0 t)
          ang (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
          dis (lambda ( a b ) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
    )
    
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect starting level text: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (/= "TEXT" (cdr (assoc 0 (setq enx (entget ent)))))
                    (princ "\nThe selected object is not text.")
                )
                (   (not (setq lvl (distof (cdr (assoc 1 enx)) 2)))
                    (princ "\nThe selected text does not have numerical content.")
                )
                (   (progn
                        (initget 6)
                        (setq slp (cond ((getreal "\nSpecify slope in decimal <0.01>: ")) (0.01))
                              lvl (* 1000.0 lvl)
                        )
                        (setvar 'osmode 695)
                        (setq pt1 (getpoint "\nSpecify first point: "))
                    )
                    (while
                        (and
                            (setq pt2 (getpoint "\nSpecify next point <exit>: " pt1))
                            (setq ins (getpoint "\nSpecify text insertion <exit>: "))
                        )
                        (setq lvl (- lvl (* (dis pt1 pt2) slp)))
                        (entmake
                            (list
                               '(000 . "TEXT")
                                (cons 010 (trans ins 1 ocs))
                                (cons 001 (strcat "IL " (rtos (/ lvl 1000.0) 2 3) "M"))
                                (assoc 40 enx)
                                (cons 050 ang)
                                (cons 210 ocs)
                            )
                        )
                        (setq pt1 pt2)
                    )
                    nil
                )
            )
        )
    )
    (setvar 'osmode osm)
    (princ)
)

Lee mac, Thank you for such a wonderful help. Its working good.

(setq p1 (getpoint "\nPick first point:"))
    (setq p1 (list (car p1)(cadr p1)))

This one I add for taking z axis only. That (xxx.xx,xxx.xxx,000.00)

I always need Z axis “00.00” because am drafting 2d some time the line has z axis, then if I will take quantity that time coming wrong.

Can you explain this this a easy way, if you don’t mind?

May 20, 2020

6 hours ago, Ajmal said:

Lee mac, Thank you for such a wonderful help. Its working good.

You're welcome.

6 hours ago, Ajmal said:
(setq p1 (getpoint "\nPick first point:"))
    (setq p1 (list (car p1)(cadr p1)))
This one I add for taking z axis only. That (xxx.xx,xxx.xxx,000.00)

I always need Z axis “00.00” because am drafting 2d some time the line has z axis, then if I will take quantity that time coming wrong.

Can you explain this this a easy way, if you don’t mind?

That addition is not necessary, as the distance calculation in my code is performed by the locally defined 'dis' function, which calculates the 2D distance.

May 21, 2020

(entmake (list '(0 . "TEXT") (cons 1 str) (cons 10 pt) (cons 40 5)))
(entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(7 . "Standard") (cons 1 str) (cons 10 pt)))

Included items necessary for writing

December 13, 2020

(defun c:drl ( / *error* ang dis ent enx ins lvl ocs osm pt1 pt2 slp lvlp )

    (defun *error* ( msg )
        (if (= 'int (type osm)) (setvar 'osmode osm))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
   
    (setq osm (getvar 'osmode)
          ocs (trans '(0.0 0.0 1.0) 1 0 t)
          ang (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
          dis (lambda ( a b ) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
    )
    
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect starting level text: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (not (wcmatch(cdr (assoc 0 (setq enx (entget ent))))"TEXT,MTEXT"))
                    (princ "\nThe selected object is not text.")
                )
                (   (not (setq lvl(car(setq lvlp(LM:parsenumbers (cdr (assoc 1 enx)))))))
                    (princ "\nThe selected text does not have numerical content.")
                )
		
		(   (/= (length lvlp) 1)
                    (princ "\nThe selected text have multiple numeric content.")
		 )
                
		
                (   (progn
                        (initget 6)
                        (setq slp (cond ((getreal "\nSpecify slope in decimal <0.01>: ")) (0.01))
                              lvl (* 1000.0 lvl)
                        )
		      (if
			(null global:ans)
			(setq global:ans "Down(-)")
			)
		      (initget "Down(-) Up(+)")
		      (if (setq tmp (getkword (strcat "\nChoose [Down(-)/Up(+)] <" global:ans ">: ")))
			(setq global:ans tmp)
			)
                        (setvar 'osmode 695)
                        (setq pt1 (getpoint "\nSpecify first point: "))
                    )
                    (while
                        (and
                            (setq pt2 (getpoint "\nSpecify next point <exit>: " pt1))
                            
                        )
		      (if (= global:ans "Down(-)")
			(progn
			  (setq lvl (- lvl (* (dis pt1 pt2) slp))))
			  (setq lvl (+ lvl (* (dis pt1 pt2) slp))))
		      (command "LEADER" pt2 PAUSE "" (strcat "IL " (rtos (/ lvl 1000.0) 2 3) "M") "" "")
                        (setq pt1 pt2)
                    )
                    nil
                )
            )
        )
    )
    (setvar 'osmode osm)
    (princ)
)
(princ "\n Drinage level  Type \"DRL\" to start")


;; Parse Numbers  -  Lee Mac
;; Parses a list of numerical values from a supplied string.

(defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list str)
    )
)

dear lee mac

how can i add your LM:GrText on this code

i try but i can't

Sign In

UCS setting

Recommended Posts

Ajmal

devitg

dlanorh

Lee Mac

Ajmal

Lee Mac

myloveflyer

Ajmal

Join the conversation

Tutorials

Forums

Activity