Leaderboard

This? (defun elperr (ch) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (setvar "cmdecho" 1) (setvar "osmode" old_osmd) (setvar "orthomode" old_orth) (setvar "snapang" old_snp) (setq *error* olderr) (princ) ) (defun c:elp ( / olderr js ent-sel ent pt_sel obj_curv old_osmd old_snp old_orth param deriv pt_tmp p_from p_to) (vl-load-com) (setq olderr *error* *error* elperr) (princ "\nRaise a perpendicular to: ") (while (not (setq js (ssget "_+.:E:S" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,RAY")))))) (setq ent-sel (ssnamex js 0) ent (cadar ent-sel) pt_sel (cadar (cdddar ent-sel)) obj_curv (vlax-ename->vla-object ent) ) (cond ((member (vlax-get-property obj_curv 'ObjectName) '("AcDbPolyline" "AcDb2dPolyline" "AcDbLine" "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbSpline" "AcDbRay" "AcDbXline") ) (setq old_osmd (getvar "osmode") old_snp (getvar "snapang") old_orth (getvar "orthomode") pt_sel (vlax-curve-getClosestPointTo obj_curv pt_sel) param (vlax-curve-getparamatpoint obj_curv pt_sel) deriv (vlax-curve-getfirstderiv obj_curv param) ) (setq pt_tmp (polar pt_sel (+ (atan (cadr deriv) (car deriv)) (/ pi 2)) 100.0)) (setvar "snapang" (angle (trans pt_sel 0 1) (trans pt_tmp 0 1))) (setvar "orthomode" 1) (if (null (setq p_from (getpoint "\nFrom point <lastpoint>: "))) (setq p_from (trans pt_sel 0 1)) ) (setvar "osmode" 0) (initget 9) (setq p_to (getpoint p_from "\nTo point : ")) (command "_.line" p_from p_to "") (setvar "osmode" old_osmd) (setvar "orthomode" old_orth) (setvar "snapang" old_snp) ) (T (princ "\nInvalid object!")) ) (setq *error* olderr) (princ) )

Okay, let's start here. Command CTA (for Change Titleblock Attributes) to start the function This selects the the title block on the current Layout, then asks the user to fill in LTSHTDESC and LTSHTNUM. ;; Load Visual Lisp (vl-load-com) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Lee Mac, read and set attributes: ;; @see http://www.lee-mac.com/attributefunctions.html ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue ( blk tag ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Get Attribute Values - Lee Mac ;; Returns an association list of attributes present in the supplied block. ;; blk - [ent] Block (Insert) Entity Name ;; Returns: [lst] Association list of ((<tag> . <value>) ... ) ;; http://www.lee-mac.com/attributefunctions.html#algetattributevaluerc (defun LM:getattributevalues ( blk / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (cons (cons (cdr (assoc 2 enx)) (cdr (assoc 1 (reverse enx))) ) (LM:getattributevalues blk) ) ) ) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (vlax-invoke blk 'getattributes) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun cgange_titleblock ( / ss blk) ;; select the title block on current layout. ;; (getvar "ctab") returns the current layout. The block keeps this information in: (assoc 410 blk) (setq ss (ssget "_X" (list (cons 0 "insert") (cons 2 "Titleblock_Properties_22x34") (cons 410 (getvar "ctab")) )) ) (setq blk (ssname ss 0)) ;; ;;(LM:vl-setattributevalue (vlax-ename->vla-object blk) "LTSHTDESC" "Detail 1 - Detail 15") (LM:vl-setattributevalue (vlax-ename->vla-object blk) "LTSHTDESC" (getstring "\nLTSHTDESC: " T)) ;;(LM:vl-setattributevalue (vlax-ename->vla-object blk) "LTSHTNUM" "D-1") (LM:vl-setattributevalue (vlax-ename->vla-object blk) "LTSHTNUM" (getstring "\nLTSHTNUM: " T)) ) ;; Type command CTA (for Change Titleblock Attributes) to start the function (defun c:cta ( / ) (cgange_titleblock) (princ) ) What more would you like the function to do? More can be automated of course. For example, we could make a list (list (list "Sheet1" "Detail 1 - Detail 15" "D-1") (list "Sheet1" "Detail 2 - Detail 15" "D-2") (list "Sheet1" "Detail 3 - Detail 15" "D-3") ;; ... ) ... then the function fills in everything ...

Maybe this have another that does not use VL. ; offset perpendicular to end of line ; by alan H 2018 (defun c:sqp ( / pt1 pt2 pt3 pt4) (setq tp1 (entsel "\nSelect line near end : ")) (setq tpp1 (entget (car tp1))) (setq pt1 (cdr (assoc 10 tpp1))) (setq pt1 (list (car pt1) (cadr pt1) 0.0)) ;reset z to zero (setq pt2 (cdr (assoc 11 tpp1))) (setq pt2 (list (car pt2) (cadr pt2) 0.0)) ;reset z to zero (setq pt3 (cadr tp1)) (setq d1 (distance pt1 pt3)) (setq d2 (distance pt2 pt3)) (if (> d1 d2) (progn (setq temp pt1) (setq pt1 pt2) (setq pt2 temp) ) ) (setq ang (angle pt1 pt2)) (setq pt3 (getpoint "\nSelect point")) (command "line" pt1 pt2 "") (setq obj (vlax-ename->vla-object (car tp1))) (setq pt4 (vlax-curve-getclosestpointto obj pt3)) (setq len (distance pt3 pt4)) (setq ang (angle pt4 pt3)) (setq pt3 (polar pt1 ang len)) (command "line" pt1 pt3 "") (Princ) ) (C:sqp)

This came up earlier!! The answer suggested just (arxload "geomcal") So maybe try without the findfile? There is also a vl- version ( maybe (vl-arx-import "geomcal.arx") which the example has an 'arx' suffix and not your 'crx' ?